Try::Tiny results from the CPAN

Try::Tiny

App-makefilepl2cpanfile

view release on metacpan or search on metacpan

use strict;
use warnings;

use Test::Most;
use Test::Memory::Cycle;
use Test::Mockingbird;
use File::Temp   qw(tempdir);
use Path::Tiny;
use Readonly;
use YAML::Tiny;

use App::makefilepl2cpanfile;

# Private helpers are called via their fully-qualified names.  No strict-refs
# trick is needed because these are compile-time-known symbol names.
# The leading underscore is a convention; Sub::Private is not enforced.

Readonly my $PKG => 'App::makefilepl2cpanfile';

# Shared fixture: a realistic Makefile.PL string exercising the common cases.
Readonly my $MF_SIMPLE => <<'END_MF';
WriteMakefile(
	PREREQ_PM => {
		'Try::Tiny' => 0,
		'Moo'       => '2.000',   # object system
	},
	TEST_REQUIRES => {
		'Test::More' => 0,
	},
	MIN_PERL_VERSION => '5.010',
);
END_MF

# A minimal deps hashref used to drive _emit without going through parse_prereqs.
my %DEPS_BASIC = (
	runtime => {
		requires => {
			'Moo' => { version => '2.000', comment => undef },
		},
	},
);

# -----------------------------------------------------------------------
# _has_version
# Strategy: cover every distinct input category â€” undef, empty string,
# numeric zero, string "0", non-zero numeric, and non-numeric strings.
# -----------------------------------------------------------------------
subtest '_has_version â€” boundary classification' => sub {

	# All of these mean "no minimum required" and must return false.
	ok !App::makefilepl2cpanfile::_has_version(undef),   'undef -> false';
	ok !App::makefilepl2cpanfile::_has_version(''),      'empty string -> false';
	ok !App::makefilepl2cpanfile::_has_version('0'),     'string "0" -> false';
	ok !App::makefilepl2cpanfile::_has_version(0),       'numeric 0 -> false';
	ok !App::makefilepl2cpanfile::_has_version('0.0'),   '"0.0" -> false (numeric zero)';

	# These represent real version constraints.
	ok  App::makefilepl2cpanfile::_has_version('1'),     '"1" -> true';
	ok  App::makefilepl2cpanfile::_has_version('1.0'),   '"1.0" -> true';
	ok  App::makefilepl2cpanfile::_has_version('0.001'), '"0.001" -> true (above zero)';
	ok  App::makefilepl2cpanfile::_has_version('5.010'), '"5.010" -> true (Perl version)';
	ok  App::makefilepl2cpanfile::_has_version('6.64'),  '"6.64" -> true';

	# A non-numeric string is not a version number so looks_like_number returns
	# false; the code then falls through to return 1 (truthy).
	ok  App::makefilepl2cpanfile::_has_version('v1.2.3'),
		'"v1.2.3" -> true (non-numeric treated as constraint)';

	diag 'all _has_version boundary cases pass' if $ENV{TEST_VERBOSE};
};

# -----------------------------------------------------------------------
# _parse_min_perl
# Strategy: test each quoting style (single, double, bare numeric) and
# confirm the function returns undef when the key is absent.
# -----------------------------------------------------------------------
subtest '_parse_min_perl â€” MIN_PERL_VERSION extraction' => sub {

	is App::makefilepl2cpanfile::_parse_min_perl("MIN_PERL_VERSION => '5.010'"),
		'5.010', 'single-quoted version extracted';

	is App::makefilepl2cpanfile::_parse_min_perl('MIN_PERL_VERSION => "5.036"'),
		'5.036', 'double-quoted version extracted';

t/function.t view on Meta::CPAN

		"requires 'Moo', '2.000';\n",
		'requires with version, no comment';

	# Phase blocks use a single tab as indentation.
	is App::makefilepl2cpanfile::_fmt_dep(
		'requires', 'Moo', { version => 0, comment => undef }, "\t"
	),
		"\trequires 'Moo';\n",
		'tab indent applied for phase blocks';

	# Inline comment appears after the semicolon, separated by three spaces.
	is App::makefilepl2cpanfile::_fmt_dep(
		'requires', 'Moo', { version => '2.000', comment => 'roles engine' }, ''
	),
		"requires 'Moo', '2.000';   # roles engine\n",
		'version and inline comment both emitted';

	# recommends keyword must be preserved as-is (not silently changed to requires).
	is App::makefilepl2cpanfile::_fmt_dep(
		'recommends', 'Future', { version => '0.33', comment => undef }, ''
	),
		"recommends 'Future', '0.33';\n",
		'recommends keyword emitted correctly';

	is App::makefilepl2cpanfile::_fmt_dep(
		'suggests', 'Log::Any', { version => 0, comment => undef }, "\t"
	),
		"\tsuggests 'Log::Any';\n",
		'suggests keyword with tab indent';

	# An empty string comment must be suppressed â€” only undef comments are
	# documented in the API, but defensive handling prevents stray ' # ' lines.
	is App::makefilepl2cpanfile::_fmt_dep(
		'requires', 'Foo', { version => 0, comment => '' }, ''
	),
		"requires 'Foo';\n",
		'empty-string comment not emitted';

	# String '0' must not produce a version argument â€” _has_version treats it as false.
	is App::makefilepl2cpanfile::_fmt_dep(
		'requires', 'Bar', { version => '0', comment => undef }, ''
	),
		"requires 'Bar';\n",
		'string "0" version not emitted';

	diag 'all _fmt_dep formatting variants pass' if $ENV{TEST_VERBOSE};
};

# -----------------------------------------------------------------------
# _extract_pairs
# Strategy: test comment capture, blank/comment line skipping, first-
# occurrence-wins across a single call and across multiple calls, return
# value, and in-place mutation semantics.
# -----------------------------------------------------------------------
subtest '_extract_pairs â€” block parser' => sub {

	# Basic: one module with version zero, one with an explicit version.
	{
		my %deps;
		App::makefilepl2cpanfile::_extract_pairs(
			"    'Try::Tiny' => 0,\n    'Moo' => '2.000',\n",
			\%deps, 'runtime', 'requires',
		);

		ok  exists $deps{runtime}{requires}{'Try::Tiny'}, 'Try::Tiny extracted';
		is  $deps{runtime}{requires}{'Try::Tiny'}{version}, 0, 'version 0 stored';
		is  $deps{runtime}{requires}{'Try::Tiny'}{comment}, undef, 'no comment stored as undef';

		ok  exists $deps{runtime}{requires}{'Moo'}, 'Moo extracted';
		is  $deps{runtime}{requires}{'Moo'}{version}, '2.000', 'explicit version stored';
	}

	# Inline comment must be captured before the comment text is stripped.
	{
		my %deps;
		App::makefilepl2cpanfile::_extract_pairs(
			"    'Foo::Bar' => 0,   # used in bin/ scripts\n",
			\%deps, 'runtime', 'requires',
		);

		is $deps{runtime}{requires}{'Foo::Bar'}{comment}, 'used in bin/ scripts',
			'inline comment captured verbatim';
	}

	# A fully-commented-out module line must be silently ignored.
	{
		my %deps;
		App::makefilepl2cpanfile::_extract_pairs(
			"    # 'Old::Module' => 0,\n",
			\%deps, 'runtime', 'requires',
		);

		ok !exists $deps{runtime}{requires}{'Old::Module'},
			'fully-commented module line is skipped';
	}

	# Blank lines must not introduce phantom entries.
	{
		my %deps;
		App::makefilepl2cpanfile::_extract_pairs(
			"\n\n    'Real' => 0,\n\n",
			\%deps, 'runtime', 'requires',
		);

		ok  exists $deps{runtime}{requires}{'Real'}, 'real entry found across blank lines';
		is  scalar keys %{ $deps{runtime}{requires} }, 1,
			'no phantom entries from blank lines';
	}

	# First-occurrence-wins within a single block: the first entry for a module
	# must not be overwritten by a subsequent entry in the same block.
	{
		my %deps;
		App::makefilepl2cpanfile::_extract_pairs(
			"    'Dup' => '1.00',   # first\n    'Dup' => '2.00',   # second\n",
			\%deps, 'runtime', 'requires',
		);

		is $deps{runtime}{requires}{'Dup'}{version}, '1.00',
			'first occurrence wins within a block';
		is $deps{runtime}{requires}{'Dup'}{comment}, 'first',
			'first comment retained';
	}

	# First-occurrence-wins across calls: a pre-populated entry in the deps
	# hashref must survive a subsequent _extract_pairs call for the same slot.
	{

t/function.t view on Meta::CPAN

		my $d = App::makefilepl2cpanfile::parse_prereqs(<<'END_MF');
WriteMakefile(
	PREREQ_PM  => { 'Moo' => 0 },
	META_MERGE => {
		prereqs => {
			runtime => {
				recommends => { 'Moo::Role' => '2.000' },
			},
		},
	},
);
END_MF
		ok exists $d->{runtime}{requires}{'Moo'},
			'PREREQ_PM parsed alongside META_MERGE';
		ok exists $d->{runtime}{recommends}{'Moo::Role'},
			'META_MERGE prereqs recommends extracted';
		is $d->{runtime}{recommends}{'Moo::Role'}{version}, '2.000',
			'META_MERGE version preserved';
	}

	# First-occurrence-wins: the same module appearing in both a simple key
	# and a structured prereqs block must appear only once.
	{
		my $d = App::makefilepl2cpanfile::parse_prereqs(<<'END_MF');
WriteMakefile(
	PREREQ_PM => { 'Dup' => '1.00' },
	prereqs   => { runtime => { requires => { 'Dup' => '2.00' } } },
);
END_MF
		ok exists $d->{runtime}{requires}{'Dup'}, 'Dup present in result';
		# Whichever occurrence was parsed first wins; both are valid.
		ok defined $d->{runtime}{requires}{'Dup'}{version},
			'Dup has exactly one version (first-occurrence-wins)';
	}

	# No memory cycles in the returned data structure.
	{
		my $d = App::makefilepl2cpanfile::parse_prereqs($MF_SIMPLE);
		memory_cycle_ok( $d, 'parse_prereqs return value has no memory cycles' );
	}

	diag 'all parse_prereqs cases pass' if $ENV{TEST_VERBOSE};
};

# -----------------------------------------------------------------------
# generate
# Strategy: use real temp-dir fixtures for filesystem interaction; mock
# File::HomeDir so config loading is deterministic and does not interfere
# with the developer's actual ~/.config file.
# -----------------------------------------------------------------------
subtest 'generate â€” integration: parse, merge, format' => sub {

	# Redirect config loading to an empty home so default develop tools are
	# injected whenever with_develop => 1 is in effect.  The guard is held for
	# the entire subtest; it restores File::HomeDir when the sub returns.
	my $empty_home = tempdir( CLEANUP => 1 );
	my $g = mock_scoped 'File::HomeDir::my_home' => sub { $empty_home };

	my $dir = tempdir( CLEANUP => 1 );
	my $mf  = path($dir)->child('Makefile.PL');
	$mf->spew_utf8("WriteMakefile(PREREQ_PM => { 'Try::Tiny' => 0 });\n");

	# ---- Guard: croak on missing file ----
	throws_ok {
		App::makefilepl2cpanfile::generate( makefile => "$dir/nonexistent.pl" )
	}
		qr/Cannot read/,
		'croaks with "Cannot read" for missing makefile';

	# ---- Guard: croak when path is a directory, not a file ----
	throws_ok {
		App::makefilepl2cpanfile::generate( makefile => $dir )
	}
		qr/Cannot read/,
		'croaks when path is a directory';

	# ---- Minimal valid Makefile.PL ----
	{
		my $out;
		lives_ok { $out = App::makefilepl2cpanfile::generate( makefile => "$mf", with_develop => 0 ) }
			'lives with a valid minimal Makefile.PL';
		like $out, qr/requires 'Try::Tiny'/, 'module appears in output';
		like $out, qr/\n$/, 'output ends with a newline';
	}

	# ---- Flat-hash calling style ----
	{
		my $r = App::makefilepl2cpanfile::generate( makefile => "$mf", with_develop => 0 );
		like $r, qr/requires 'Try::Tiny'/, 'flat hash calling style works';
	}

	# ---- Hashref calling style ----
	{
		my $r = App::makefilepl2cpanfile::generate(
			{ makefile => "$mf", with_develop => 0 }
		);
		like $r, qr/requires 'Try::Tiny'/, 'hashref calling style works';
	}

	# ---- with_develop defaults to 1 when the argument is omitted ----
	{
		my $r = App::makefilepl2cpanfile::generate( makefile => "$mf" );
		like $r, qr/Perl::Critic/, 'with_develop defaults to 1 â€” develop block present';
	}

	# ---- with_develop => 0 suppresses the develop block entirely ----
	{
		my $r = App::makefilepl2cpanfile::generate( makefile => "$mf", with_develop => 0 );
		unlike $r, qr/on 'develop'/, 'with_develop => 0 suppresses develop block';
	}

	# ---- Existing cpanfile 'requires' in develop block is merged ----
	{
		my $existing = "on 'develop' => sub {\n  requires 'My::Tool';\n};\n";
		my $r = App::makefilepl2cpanfile::generate(
			makefile => "$mf", existing => $existing, with_develop => 0
		);
		like $r, qr/My::Tool/, 'existing develop requires entry merged';
	}

	# ---- Existing cpanfile 'recommends' in develop block is merged ----
	{
		my $existing = "on 'develop' => sub {\n  recommends 'My::Nice::Tool';\n};\n";
		my $r = App::makefilepl2cpanfile::generate(
			makefile => "$mf", existing => $existing, with_develop => 0
		);
		like $r, qr/My::Nice::Tool/, 'existing develop recommends entry merged';
	}

	# ---- Hand-curated entry must not be overwritten by default injection ----
	# If Perl::Critic already appears in the existing cpanfile with a specific
	# version, the injection step must not add a duplicate entry.
	{
		my $existing = "on 'develop' => sub {\n  requires 'Perl::Critic', '1.140';\n};\n";
		my $r = App::makefilepl2cpanfile::generate(
			makefile => "$mf", existing => $existing, with_develop => 1
		);
		like $r, qr/Perl::Critic.*1\.140|1\.140.*Perl::Critic/,
			'hand-curated Perl::Critic version not overwritten';
		my @hits = ( $r =~ /Perl::Critic/g );
		is scalar @hits, 1, 'Perl::Critic appears exactly once after merge';
	}

	# ---- MIN_PERL_VERSION is emitted when present in the Makefile.PL ----
	{
		$mf->spew_utf8(
			"WriteMakefile(MIN_PERL_VERSION => '5.016', PREREQ_PM => { 'X' => 0 });\n"
		);
		my $r = App::makefilepl2cpanfile::generate( makefile => "$mf", with_develop => 0 );
		like $r, qr/requires 'perl', '5\.016'/, 'MIN_PERL_VERSION emitted';
	}

	# ---- No memory cycles in the generated string ----
	{
		$mf->spew_utf8("WriteMakefile(PREREQ_PM => { 'Y' => 0 });\n");
		my $r = App::makefilepl2cpanfile::generate( makefile => "$mf", with_develop => 0 );
		memory_cycle_ok( \$r, 'generate return value has no memory cycles' );

( run in 2.008 seconds using v1.01-cache-2.11-cpan-6de40a662fe )