view release on metacpan or  search on metacpan

lib/App/makefilepl2cpanfile.pm  view on Meta::CPAN

#
# First-occurrence-wins: if the same module appears multiple times (e.g.
# once in PREREQ_PM and once in a prereqs block), the first parsed entry
# is kept.
sub _extract_pairs {
	my ($block, $deps, $phase, $rel) = @_;

	for my $line (split /\n/, $block) {
		# Capture any trailing inline comment before stripping it.
		# (.*\S) is O(N): greedy .* scans to end, then gives back trailing
		# spaces one by one until \S anchors on the last non-space char.
		# Avoids the super-linear behaviour of (.+?)\s*$ which re-evaluates
		# \s*$ at every expanded position of the lazy quantifier.
		my ($comment) = ($line =~ /#\s*(.*\S)/);
		$line =~ s/#.*$//;

		next unless $line =~ /\S/;		# skip blank / formerly comment-only lines

		if ($line =~ /['"]([^'"]+)['"]\s*=>\s*['"]?([\d._]+)?['"]?/) {
			my ($mod, $ver) = ($1, $2);
			# Defense-in-depth: [^'"]+ already excludes quote characters, but
			# it also matches \n.  A newline in a module name produces a
			# multi-line string literal in the cpanfile.  Restrict to valid
			# Perl identifier paths to make the output unambiguously well-formed.
			next unless $mod =~ /\A[A-Za-z_]\w*+(?:::\w++)*+\z/;
			# First occurrence wins — do not overwrite already-parsed entries.
			$deps->{$phase}{$rel}{$mod} //= {
				version => $ver // 0,
				comment => $comment,
			};
		}
	}

	return;
}

# _parse_min_perl
#
# Purpose:  Extract the MIN_PERL_VERSION value from Makefile.PL text.
# Entry:    $_[0] — raw Makefile.PL content string.
# Exit:     The version string (e.g. '5.010'), or undef if not declared.
sub _parse_min_perl {
	my $content = $_[0];
	return ($content =~ /\bMIN_PERL_VERSION\b\s*=>\s*['"]?([\d._]++)['"]?/)
		? $1
		: undef;
}

# _load_develop_config
#
# Return the develop-tools hash from the user's YAML config file,
#   or %DEFAULT_DEVELOP when no config file exists.
# Entry:    None — reads from the filesystem at a well-known path.
# Exit:     HashRef { Module::Name => minimum_version_or_0 }.
# Effects:  Reads from disk. Croaks on YAML parse failure. Carps when the
#           config file lacks a 'develop' key.
sub _load_develop_config {
	my $home = File::HomeDir->my_home;

	# Guard against environments with no home directory (containers, chroots,
	# or CI systems where getpwuid returns no directory).  path(undef) would
	# croak from Path::Tiny with a confusing message; return defaults instead.
	return {%DEFAULT_DEVELOP} unless defined $home;

	my $cfg_path = path($home)
		->child('.config', 'makefilepl2cpanfile.yml');

	if ($cfg_path->is_file) {
		my $yaml = YAML::Tiny->read("$cfg_path")
			or croak "Failed to parse $cfg_path: " . YAML::Tiny->errstr();

		if (ref $yaml->[0]{develop} eq 'HASH') {
			# SECURITY: validate every key (module name) and value (version)
			# before use.  YAML config keys are arbitrary strings; without
			# this guard a key such as "Safe'; system('evil'); requires 'X"
			# closes the single-quoted literal in _fmt_dep and injects
			# executable Perl into the generated cpanfile, which cpanm eval's.
			my %clean;
			for my $mod (keys %{ $yaml->[0]{develop} }) {
				my $ver = $yaml->[0]{develop}{$mod};
				unless ($mod =~ /\A[A-Za-z_]\w*+(?:::\w++)*+\z/) {
					carp "Skipping invalid module name in $cfg_path: '$mod'";
					next;
				}
				my $v = defined $ver ? "$ver" : 0;
				unless ($v eq '0' || $v eq '' || $v =~ /\Av?[\d._]++\z/) {
					carp "Skipping invalid version for '$mod' in $cfg_path: '$v'";
					$v = 0;
				}
				$clean{$mod} = $v;
			}
			return \%clean;
		}
		carp "No 'develop' key found in $cfg_path; using defaults";
	}

	# Return a copy so callers cannot mutate the constant.
	return {%DEFAULT_DEVELOP};
}

# _emit
#
# Purpose:  Pure formatter — converts the structured dependency hash and an
#           optional minimum Perl version into a valid cpanfile string.
# Entry:    $_[0] — HashRef (see DATA STRUCTURE section in POD)
#           $_[1] — optional Str minimum Perl version (e.g. '5.010')
# Exit:     Scalar string; always terminated with exactly one newline.
#           Never returns undef.
#
# Runtime deps are emitted at the top level (no 'on' block) per cpanfile
# convention. All other phases get 'on phase => sub { ... }' blocks.
# Within each phase, relationships are emitted in @REL_ORDER order;
# modules within each relationship are sorted alphabetically.
# Inline comments are re-emitted after the semicolon on the same line.
# A version of 0 or '' means "any version" and is omitted.
sub _emit {
	my ($deps, $min_perl) = @_;

	# Build the output as a list of sections joined by blank lines.  This
	# avoids the trailing-double-newline bug that arises when a runtime-only
	# output adds a separator newline with no following phase blocks.