view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	is($buffer, "\"name\"\n\"Caf\xE9 \x80\"\n", 'e-acute and Euro converted');
	is_deeply(\@calls, [[$CONFIG{mdb_export}, ['--', $CONFIG{database}, $CONFIG{table}]]], 'mdb-export arguments, options ended by --');
};

subtest 'Exporter::_export_transcoded reports bad input with line numbers' => sub {
	my $dir = tempdir(CLEANUP => 1);
	open my $out, '>:raw', \my $buffer or die $!;

	{
		my $guard = mock_scoped(mock_export_output("ok\nCaf\xE9\n"));
		throws_ok { new_exporter(output_dir => $dir)->_export_transcoded($CONFIG{database}, $CONFIG{table}, $out) }
			qr/\ATable $CONFIG{table}, line 2: output of mdb-export is not valid UTF-8 at /, 'invalid UTF-8';
	}
	{
		my $guard = mock_scoped(mock_export_output("ok\nok\n\xE6\x97\xA5\n"));
		throws_ok { new_exporter(output_dir => $dir)->_export_transcoded($CONFIG{database}, $CONFIG{table}, $out) }
			qr/\ATable $CONFIG{table}, line 3: cannot be represented in cp1252 at /, 'unmappable character';
	}
};

subtest 'Exporter::_export_transcoded leaves the caller\'s $. and $@ alone' => sub {
	# Reading the spool file must not change which handle $. refers to
	open my $in, '<', \"one\ntwo\nthree\n" or die $!;
	<$in> for 1 .. 2;
	my $before = $.;

	my $guard = mock_scoped(mock_export_output("a\nb\nc\nd\n"));
	open my $out, '>:raw', \my $buffer or die $!;
	my $e = new_exporter(output_dir => tempdir(CLEANUP => 1));
	local $@ = $CONFIG{sentinel};
	$e->_export_transcoded($CONFIG{database}, $CONFIG{table}, $out);

	is($., $before, '$. still refers to the caller\'s handle');
	is($@, $CONFIG{sentinel}, '$@ localised');
};

subtest 'Exporter::_install_file renames into place with normal permissions' => sub {
	my $dir = tempdir(CLEANUP => 1);
	my $outfile = File::Spec->catfile($dir, 'out.csv');
	my $e = new_exporter(output_dir => $dir);

	my $old_umask = umask(oct(22));
	{
		my $tmp = File::Temp->new(DIR => $dir, UNLINK => 1);
		print {$tmp} "data\n";
		local $@ = $CONFIG{sentinel};
		is($e->_install_file($tmp, $outfile), $e, 'returns $self');
		is($@, $CONFIG{sentinel}, '$@ localised');
		ok(!-e $tmp->filename(), 'temporary name gone');
	}
	umask($old_umask);

	ok(-f $outfile, 'still there after the temporary object is destroyed');

	# Whatever the platform, the result is an ordinary file the user can
	# read and write (File::Temp's own files are private, mode 0600)
	ok(-r $outfile && -w $outfile, 'readable and writable');

	SKIP: {
		# Windows has no Unix permission bits: stat() makes the mode up from
		# the read-only flag (0666 for any writable file) and umask has no
		# effect, so the exact bits can only be checked elsewhere
		skip('Unix permission bits do not exist on Windows', 1) if $^O eq 'MSWin32';
		is((stat($outfile))[2] & oct(777), oct(644), '0666 less umask 022');
	}
};

subtest 'Exporter::_install_file croaks with the OS reason on failure' => sub {
	my $dir = tempdir(CLEANUP => 1);
	my $outfile = File::Spec->catfile($dir, 'no', 'such', 'dir', 'out.csv');
	my $tmp = File::Temp->new(DIR => $dir, UNLINK => 1);

	throws_ok { new_exporter()->_install_file($tmp, $outfile) } qr/\ACannot write \Q$outfile\E: \Q$ENOENT_TEXT\E at /, 'exact message';
};

subtest 'Exporter::_count_rows reads the number from mdb-count' => sub {
	my ($output, @calls) = ("  $CONFIG{row_count}\n");
	my $guard = mock_scoped("$CONFIG{exporter}::_run_program" => sub {
		push @calls, [$_[1], $_[2]];
		${ $_[3] } = $output;
		return $_[0];
	});

	my $rows = new_exporter()->_count_rows($CONFIG{database}, $CONFIG{table});
	is($rows, $CONFIG{row_count}, 'number parsed despite whitespace');
	returns_ok($rows, { type => 'integer', min => 0 }, 'an integer');
	is_deeply(\@calls, [[$CONFIG{mdb_count}, ['--', $CONFIG{database}, $CONFIG{table}]]], 'mdb-count arguments, options ended by --');

	# Anything that is not just a number is reported, never taken as 0
	$output = '';
	throws_ok { new_exporter()->_count_rows($CONFIG{database}, $CONFIG{table}) } qr/\Amdb-count printed no number: "" at /, 'no output: reported';
	$output = "count: 12 rows\n";
	throws_ok { new_exporter()->_count_rows($CONFIG{database}, $CONFIG{table}) } qr/\Amdb-count printed no number: "count: 12 rows\\x0A" at /, 'extra text: reported';
};

# Replaces run3 with a double that records its arguments, writes to
# stderr and sets the child status
sub mock_run3 {
	my ($status, $stderr_text, $calls) = @_;
	return ("$CONFIG{exporter}::run3" => sub {
		my ($cmd, $stdin, $stdout, $stderr) = @_;
		push @{$calls}, [$cmd, $stdin, $stdout] if $calls;
		${$stderr} = $stderr_text;
		$? = $status;
		return 1;
	});
}

subtest 'Exporter::_run_program runs the program with a list, not a shell string' => sub {
	my @calls;
	my $guard = mock_scoped(mock_run3(0, '', \@calls));

	my $e = new_exporter();
	$e->{programs} = { $CONFIG{mdb_export} => program_path($CONFIG{mdb_export}) };
	my $stdout = '';
	is($e->_run_program($CONFIG{mdb_export}, [$CONFIG{database}, 'Or; rm -rf /'], \$stdout), $e, 'returns $self');
	verbose_diag('run3 call', \@calls);

	is_deeply($calls[0][0], [program_path($CONFIG{mdb_export}), $CONFIG{database}, 'Or; rm -rf /'], 'command as a list');
	is(${ $calls[0][1] }, undef, 'stdin is empty');
	is($calls[0][2], \$stdout, 'stdout passed through');
};

subtest 'Exporter::_run_program croaks on exit status and signals' => sub {