App-Test-Generator

 view release on metacpan or  search on metacpan

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

		if ($code =~ /defined\s*\(\s*\$$param\s*\)/) {
			$$p->{optional} = 0;
			$self->_log("  CODE: $param is required (defined check)");
		}

		# Determine optional/required and numeric type from code
		if ($code =~ /\s*\$$param\s*(?:\/\/|\|\|)=/) {
			# e.g. $var //= 5; or $var ||= 5;
			$$p->{optional} = 1;
			$self->_log("  CODE: $param is optional (default value assigned in code)");
		} elsif ($code =~ /\s*\$$param\s*(?:[\+\-\*\%]|\/(?!\/)|(?:\+\+)|(?:--)|(?:[\+\-\*\%]=|\/(?!\/)=)|\+\$|\$[+-])/ ) {
			# Covers arithmetic usage:
			# $x + $param, $param++, $param--, $x += $param, $x -= $param, etc.
			$$p->{optional} = 0;
			$$p->{type} //= 'number';
			$self->_log("  CODE: $param is required (used in arithmetic context)");
		} elsif ($code =~ /\$\b$param\b\s*(?:\+0|\*1)/) {
			# Forces numeric context, e.g., "$param + 0" or "$param * 1"
			$$p->{optional} = 0;
			$$p->{type} //= 'number';
			$self->_log("  CODE: $param is required (numeric context)");

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

			# Only set max if it tightens the range
			my $max = ($op eq '<') ? $val - 1 : $val;
			$p->{max} = $max if !defined($p->{max}) || $max < $p->{max};
		} elsif ($op eq '>' || $op eq '>=') {
			my $min = ($op eq '>') ? $val + 1 : $val;
			$p->{min} = $min if !defined($p->{min}) || $min > $p->{min};
		}
	}

	# Regex pattern matching with better capture
	if ($code =~ /\$$param\s*=~\s*((?:qr?\/[^\/]+\/|\$[\w:]+|\$\{\w+\}))/) {
		my $pattern = $1;
		$p->{type} ||= 'string';

		# Clean up the pattern if it's a straightforward regex
		if ($pattern =~ /^qr?\/([^\/]+)\/$/) {
			$p->{matches} = "/$1/";
		} else {
			$p->{matches} = $pattern;
		}
		$self->_log("  CODE: $param matches pattern: $p->{matches}");

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

	return undef unless $param && $code;

	# Clean up the code for easier pattern matching
	# Remove comments to avoid false positives
	my $clean_code = $code;
	$clean_code =~ s/#.*$//gm;
	$clean_code =~ s/^\s+|\s+$//g;

	# Pattern 1: $param = $param || 'default_value'
	# Also handles: $param = $arg || 'default'
	if ($clean_code =~ /\$$param\s*=\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*\|\|\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 2: $param //= 'default_value'
	if ($clean_code =~ /\$$param\s*\/\/=\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 3: $param = defined $param ? $param : 'default'
	# Also handles: $param = defined $arg ? $arg : 'default'
	if ($clean_code =~ /\$$param\s*=\s*defined\s+(?:\$$param|\$[a-zA-Z_]\w*)\s*\?\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*:\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 4: $param = 'default' unless defined $param;
	if ($clean_code =~ /\$$param\s*=\s*([^;]+?)\s+unless\s+defined\s+(?:\$$param|\$[a-zA-Z_]\w*)/) {
		my $default = $1;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 5: $param ||= 'default'
	if ($clean_code =~ /\$$param\s*\|\|=\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 6: $param = $arg // 'default'
	if ($clean_code =~ /\$$param\s*=\s*(?:\$$param|\$[a-zA-Z_]\w*)\s*\/\/\s*([^;]+)/) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;
		$default = $self->_clean_default_value($default);
		return $default if defined $default;
	}

	# Pattern 7: Multi-line: if (!defined $param) { $param = 'default'; }
	if ($clean_code =~ /if\s*\(\s*!defined\s+\$$param\s*\)\s*\{[^}]*\$$param\s*=\s*([^;]+)/s) {
		my $default = $1;
		$default =~ s/\s*;\s*$//;

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

	# Handle __PACKAGE__ and similar constants
	if ($value eq '__PACKAGE__') {
		return '__PACKAGE__';
	}

	# Remove surrounding parentheses
	$value =~ s/^\((.+)\)$/$1/;

	# Handle expressions we can't evaluate
	if ($value =~ /^\$[a-zA-Z_]/ || $value =~ /\(.*\)/) {
		return if($value =~ /^\$|\@|\%/);	# The default is a value, so who knows its type?
		# return $value;
	}

	return $value;
}

# --------------------------------------------------
# _validate_pod_code_agreement
#