view release on metacpan or  search on metacpan

t/transaction.t  view on Meta::CPAN

		open STDERR, '>', "$dir/stderr" or die $!;
		open STDOUT, '>', File::Spec->devnull() or die $!;
		exec($^X, "-I$LIB", $SCRIPT, '--no-log', '--overwrite', '--output-dir', $out, $db) or die "exec: $!";
	}
	for (1 .. $CONFIG{wait_steps}) {
		last if @{ temp_files($out) };
		sleep $CONFIG{wait_step};
	}
	kill $signal, $to_group ? -$pid : $pid;
	waitpid($pid, 0);
	my $status = $? >> 8;
	kill 'KILL', -$pid;   # tidy away the stand-in mdb-export if it lingers
	return { status => $status, stderr => slurp("$dir/stderr") // '', out => $out };
}

subtest 'Phase: interrupted mid-transaction -> rollback and stop' => sub {
	# Ctrl-C reaches the whole process group; kill/service managers send
	# TERM to the program.  Either way the table in flight is rolled back
	# and no further table is started.
	foreach my $case (['INT', 1, 'Ctrl-C (SIGINT to the group)'], ['TERM', 0, 'SIGTERM to the program']) {
		my ($signal, $group, $name) = @{$case};
		my $result = interrupt($signal, $group);
		verbose_diag($name, $result);
		is($result->{status}, $CONFIG{exit_fatal}, "$name: stopped (exit 3)");
		like($result->{stderr}, qr/access2csv: Interrupted by SIG$signal: stopped, and the table being exported was discarded/, "$name: says so");
		is(slurp("$result->{out}/Slow.csv"), $CONFIG{old_content}, "$name: old file intact");
		is_deeply(temp_files($result->{out}), [], "$name: temporary file rolled back");
		ok(!-e "$result->{out}/Zebra.csv", "$name: the next table was not started");
	}
};

subtest 'Phase: a caller\'s own signal handlers are respected' => sub {
	# The exporter only takes over signals nobody else is handling, and
	# gives them back afterwards
	my $dir = tempdir(CLEANUP => 1);
	my $db = make_database($dir, 'A');
	my $mine = sub { };
	local $SIG{TERM} = $mine;
	local $SIG{HUP};
	my %during;
	before("$CONFIG{exporter}::_export_table", sub { %during = (TERM => $SIG{TERM}, HUP => $SIG{HUP}) });
	export(db => $db, output_dir => "$dir/out");
	restore_all();
	is($during{TERM}, $mine, 'during: the caller\'s TERM handler untouched');
	is(ref($during{HUP}), 'CODE', 'during: HUP handled by the exporter');
	is($SIG{TERM}, $mine, 'after: TERM as before');
	ok(!defined($SIG{HUP}) || $SIG{HUP} eq 'DEFAULT' || $SIG{HUP} eq '', 'after: HUP restored');
};

#######################################################################
# Phase 5: repeating the same transaction
#######################################################################

subtest 'Phase: repeat without --overwrite -> refused, existing data untouched' => sub {
	# Documented: a second run refuses to replace files.  That refusal
	# must not damage what the first run committed, however often it runs.
	my $dir = tempdir(CLEANUP => 1);
	my $db = make_database($dir, 'A', 'B');
	my $first = export(db => $db, output_dir => "$dir/out");
	is($first->{status}, $CONFIG{exit_ok}, 'first run commits');
	my %committed = map { $_ => [slurp("$dir/out/$_"), (stat("$dir/out/$_"))[9]] } qw(A.csv B.csv);

	foreach my $repeat (1 .. 2) {
		my $again = export(db => $db, output_dir => "$dir/out");
		is($again->{status}, $CONFIG{exit_failure}, "repeat $repeat: refused");
		is(scalar(() = $again->{stderr} =~ /Output file already exists/g), 2, "repeat $repeat: both tables refused");
		foreach my $file (sort keys %committed) {
			is(slurp("$dir/out/$file"), $committed{$file}[0], "repeat $repeat: $file content unchanged");
			is((stat("$dir/out/$file"))[9], $committed{$file}[1], "repeat $repeat: $file not even rewritten");
		}
		is_deeply(temp_files("$dir/out"), [], "repeat $repeat: no temporary files");
	}
};

subtest 'Phase: repeat with --overwrite -> the same result every time' => sub {
	# With overwrite the transaction is idempotent: same names (even for
	# colliding tables), same bytes; the log grows but earlier lines stay
	my $dir = tempdir(CLEANUP => 1);
	my $db = make_database($dir, 'A/B', 'A:B', 'Unicode');
	my $log = "$dir/run.log";
	my (@snapshots, @log_sizes);
	foreach my $run (1 .. 3) {
		my ($status);
		capture { $status = App::Access2CSV->run('--log', $log, '--overwrite', '--no-progress', '--output-dir', "$dir/out", $db) };
		is($status, $CONFIG{exit_ok}, "run $run: status 0");
		opendir my $dh, "$dir/out" or die $!;
		push @snapshots, { map { $_ => slurp("$dir/out/$_") } grep { !/\A\./ } readdir $dh };
		push @log_sizes, -s $log;
	}
	is_deeply($snapshots[1], $snapshots[0], 'run 2 identical to run 1');
	is_deeply($snapshots[2], $snapshots[0], 'run 3 identical to run 1');
	is_deeply([sort keys %{ $snapshots[0] }], ['A_B.csv', 'A_B_2.csv', 'Unicode.csv'], 'same names each time');
	ok($log_sizes[0] < $log_sizes[1] && $log_sizes[1] < $log_sizes[2], 'log appended, never truncated');
};

subtest 'Phase: repeated dry runs -> identical, and nothing written' => sub {
	my $dir = tempdir(CLEANUP => 1);
	my $db = make_database($dir, 'A/B', 'A:B');
	my @outputs = map { export(db => $db, output_dir => "$dir/out", dry_run => 1)->{stdout} } 1 .. 3;
	is($outputs[1], $outputs[0], 'second listing identical');
	is($outputs[2], $outputs[0], 'third listing identical');
	ok(!-e "$dir/out", 'nothing created');
};

subtest 'Phase: fail, then retry -> same final state as a clean run' => sub {
	# A fault in the first attempt must not leave anything that makes the
	# retry differ from a run that never failed
	my $dir = tempdir(CLEANUP => 1);
	my $db = make_database($dir, 'A', 'B');
	{
		my $guard = fake_export(sub { die "run3(): transient failure\n" if $_[0][-1] eq 'B'; print { $_[1] } "\"id\",\"name\"\n1,\"$_[0][-1]\"\n" });
		my $first = export(db => $db, output_dir => "$dir/retry");
		is($first->{status}, $CONFIG{exit_failure}, 'first attempt: B failed');
	}
	my $retry = export(db => $db, output_dir => "$dir/retry", overwrite => 1);
	is($retry->{status}, $CONFIG{exit_ok}, 'retry succeeds');
	export(db => $db, output_dir => "$dir/clean");
	foreach my $file (qw(A.csv B.csv)) {
		is(slurp("$dir/retry/$file"), slurp("$dir/clean/$file"), "$file: same as a clean run");
	}
	is_deeply(temp_files("$dir/retry"), [], 'no temporary files');
};

restore_all();

done_testing();