view release on metacpan or  search on metacpan

t/50_inplace.t  view on Meta::CPAN

	# test that both regular $^I and our tied class act the same
	die "bad nr of args" unless @_==2 || @_==3;
	my ($name, $sub, $args) = @_;
	my $stdin = delete $$args{stdin};
	{
		local $TESTMODE = 'Perl';
		local (*ARGV, *ARGVOUT, $., $^I);  ## no critic (RequireInitializationForLocalVars)
		$^I = $$args{backup}||'';  ## no critic (RequireLocalizedPunctuationVars)
		my $osi = defined($stdin) ? OverrideStdin->new($stdin) : undef;
		subtest "$name - Perl" =>
			$^O eq 'MSWin32' && $] lt '5.028' && !length($^I)
				? sub { plan skip_all=>'This test would fail on Win32 with Perls older then 5.28' }
					# see https://perldoc.pl/perldiag#Can't-do-inplace-edit-without-backup
					# and https://perldoc.pl/perl5280delta#In-place-editing-with-perl-i-is-now-safer
				: $sub;
		$osi and $osi->restore;
	}
	{
		local $TESTMODE = 'Inplace';
		local (*ARGV, *ARGVOUT, $., $^I);  ## no critic (RequireInitializationForLocalVars)
		local $CE = $] lt '5.012';
		my $inpl = File::Replace::Inplace->new(debug=>$DEBUG, %$args);
		my $osi = defined($stdin) ? OverrideStdin->new($stdin) : undef;
		subtest "$name - ::Inplace" => $sub;
		$osi and $osi->restore;
	}
	return;
}

testboth 'basic test' => sub { plan tests=>9;
	my @tf = (newtempfn("Foo\nBar\n"), newtempfn("Quz\nBaz"));
	@ARGV = @tf;  ## no critic (RequireLocalizedPunctuationVars)
	my @states;
	is select(), 'main::STDOUT', 'STDOUT is selected initially';
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof];
	while (<>) {
		print "$ARGV:$.: ".uc;
		isnt select(), 'main::STDOUT', 'STDOUT isn\'t selected in loop';
		push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof, $_];
	}
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof];
	is select(), 'main::STDOUT', 'STDOUT is selected again';
	is slurp($tf[0]), "$tf[0]:1: FOO\n$tf[0]:2: BAR\n", 'file 1 contents';
	is slurp($tf[1]), "$tf[1]:3: QUZ\n$tf[1]:4: BAZ", 'file 2 contents';
	is_deeply \@states, [
		[[@tf],    undef,  !!0, !!0, $FL, $FE         ],
		[[$tf[1]], $tf[0], !!1, !!1, 1,   !!0, "Foo\n"],
		[[$tf[1]], $tf[0], !!1, !!1, 2,   !!1, "Bar\n"],
		[[],       $tf[1], !!1, !!1, 3,   !!0, "Quz\n"],
		[[],       $tf[1], !!1, !!1, 4,   !!1, "Baz"  ],
		[[],       $tf[1], !!0, !!0, 4,   !!1         ],
	], 'states' or diag explain \@states;
};

testboth 'basic test with eof()' => sub {
	if ($CE) { plan skip_all=>"eof() not supported on tied handles on Perl<5.12" }
	elsif ($^O eq 'MSWin32') { plan skip_all=>"eof() acts differently on Win32" }
	elsif ($^O eq 'cygwin') { plan skip_all=>"this test doesn't work on cygwin" }
	else { plan tests=>9 }
	my @tf = (newtempfn("Foo\nBar"), newtempfn("Quz\nBaz\n"));
	local @ARGV = @tf; # this also tests "local"ization after constructing the object
	my @states;
	is select(), 'main::STDOUT', 'STDOUT is selected initially';
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof], eof();
	# eof() will open the first file, so record the current state again:
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof], eof();
	while (<>) {
		print "$ARGV:$.: ".uc;
		isnt select(), 'main::STDOUT', 'STDOUT isn\'t selected in loop';
		push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof, $_], eof();
	}
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof];
	is select(), 'main::STDOUT', 'STDOUT is selected again';
	is slurp($tf[0]), "$tf[0]:1: FOO\n$tf[0]:2: BAR", 'file 1 contents';
	is slurp($tf[1]), "$tf[1]:3: QUZ\n$tf[1]:4: BAZ\n", 'file 2 contents';
	is_deeply \@states, [
		[[@tf],    undef,  !!0, !!0, $FL, $FE         ], !!0,
		[[$tf[1]], $tf[0], !!1, !!1, 0,   !!0         ], !!0,
		[[$tf[1]], $tf[0], !!1, !!1, 1,   !!0, "Foo\n"], !!0,
		[[$tf[1]], $tf[0], !!1, !!1, 2,   !!1, "Bar"  ], !!0,
		[[],       $tf[1], !!1, !!1, 3,   !!0, "Quz\n"], !!0,
		[[],       $tf[1], !!1, !!1, 4,   !!1, "Baz\n"], !!1,
		[[],       $tf[1], !!0, !!0, 4,   !!1         ],
	], 'states' or diag explain \@states;
};

subtest 'custom files & filename' => sub { plan tests=>9;
	local (*ARGV, *ARGVOUT, $., $^I);  ## no critic (RequireInitializationForLocalVars)
	my @testfiles1;
	my $testfilename1;
	my $inpl = File::Replace::Inplace->new(debug=>$DEBUG, files=>\@testfiles1, filename=>\$testfilename1);
	my @tf = (newtempfn("Foo\nBar"), newtempfn("Quz\nBaz"));
	my @states;
	@ARGV = ("qrs");  ## no critic (RequireLocalizedPunctuationVars)
	@testfiles1 = @tf;
	is select(), 'main::STDOUT', 'STDOUT is selected initially';
	push @states, [[@ARGV], $ARGV, [@testfiles1], $testfilename1, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof];
	while (<>) {
		print "$testfilename1/$./".lc;
		isnt select(), 'main::STDOUT', 'STDOUT isn\'t selected in loop';
		push @states, [[@ARGV], $ARGV, [@testfiles1], $testfilename1, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof, $_];
	}
	push @states, [[@ARGV], $ARGV, [@testfiles1], $testfilename1, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof];
	is select(), 'main::STDOUT', 'STDOUT is selected again';
	is slurp($tf[0]), "$tf[0]/1/foo\n$tf[0]/2/bar", 'file 1 contents';
	is slurp($tf[1]), "$tf[1]/3/quz\n$tf[1]/4/baz", 'file 2 contents';
	is_deeply \@states, [
		[["qrs"], undef, [@tf],    undef,  !!0, !!0, $FL, $FE         ],
		[["qrs"], undef, [$tf[1]], $tf[0], !!1, !!1, 1,   !!0, "Foo\n"],
		[["qrs"], undef, [$tf[1]], $tf[0], !!1, !!1, 2,   !!1, "Bar"  ],
		[["qrs"], undef, [],       $tf[1], !!1, !!1, 3,   !!0, "Quz\n"],
		[["qrs"], undef, [],       $tf[1], !!1, !!1, 4,   !!1, "Baz"  ],
		[["qrs"], undef, [],       $tf[1], !!0, !!0, 4,   !!1         ],
	], 'states' or diag explain \@states;
	untie *ARGV;
};

subtest 'basic test with inplace()' => sub { plan tests=>12;
	local (*ARGV, *ARGVOUT, $., $^I);  ## no critic (RequireInitializationForLocalVars)
	my @tf = (newtempfn("X\nY\nZ"), newtempfn("AA\nBB\nCC\n"));
	@ARGV = @tf;  ## no critic (RequireLocalizedPunctuationVars)