view release on metacpan or  search on metacpan

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

#             field name if :param(name) was used)
#             determines the parameter key.
# --------------------------------------------------
sub _merge_field_declarations {
	my ($self, $params, $fields) = @_;

	foreach my $field_name (keys %$fields) {
		my $field = $fields->{$field_name};

		# Only process fields that are parameters
		next unless $field->{is_param};

		my $param_name = $field->{param_name};

		# Create or update parameter info
		$params->{$param_name} ||= {};
		my $p = $params->{$param_name};

		# Merge field information into parameter
		$p->{_source} = 'field' unless $p->{_source};
		$p->{field_name} = $field_name if $field_name ne $param_name;

		if ($field->{_default}) {
			$p->{_default} = $field->{_default};
			$p->{optional} = 1;
		}

		if ($field->{isa}) {
			$p->{isa} = $field->{isa};
			$p->{type} = 'object';
		}

		$self->_log("  MERGED: Field $field_name -> parameter $param_name");
	}
}

# --------------------------------------------------
# _extract_defaults_from_code
#
# Purpose:    Scan a method body for default value
#             assignment patterns and populate the
#             optional and _default fields of
#             known parameters.
#
# Entry:      $params - hashref of parameters
#                       (modified in place).
#             $code   - method body source string.
#             $method - method hashref, used for
#                       constructor-specific
#                       exclusions of $class and
#                       $self.
#
# Exit:       Returns nothing. Modifies $params
#             in place.
#
# Side effects: Logs detections to stdout when
#               verbose is set.
#
# Notes:      Eight default patterns are tried.
#             Only parameters already present in
#             $params are updated — this method
#             does not add new parameters.
#             Falls back to extracting all @_
#             assignments if $params is empty
#             after the main pass.
# --------------------------------------------------
sub _extract_defaults_from_code {
	my ($self, $params, $code, $method) = @_;

	# Pattern 1: my $param = value;
	while ($code =~ /my\s+\$(\w+)\s*=\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default: " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 2: $param = value unless defined $param;
	while ($code =~ /\$(\w+)\s*=\s*([^;]+?)\s+unless\s+(?:defined\s+)?\$\1/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (unless): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 3: $param = value unless $param;
	while ($code =~ /\$(\w+)\s*=\s*([^;]+?)\s+unless\s+\$\1/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (unless): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 4: $param = $param || 'default';
	while ($code =~ /\$(\w+)\s*=\s*\$\1\s*\|\|\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (||): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 5: $param ||= 'default';
	while ($code =~ /\$(\w+)\s*\|\|=\s*([^;]+);/g) {
		my ($param, $value) = ($1, $2);
		next unless exists $params->{$param};

		$params->{$param}{_default} = $self->_clean_default_value($value, 1);
		$params->{$param}{optional} = 1;
		$self->_log("  CODE: $param has default (||=): " . $self->_format_default($params->{$param}{_default}));
	}

	# Pattern 6: $param //= 'default';
	while ($code =~ /\$(\w+)\s*\/\/=\s*([^;]+);/g) {