App-Access2CSV

 view release on metacpan or  search on metacpan

lib/App/Access2CSV/Exporter.pm  view on Meta::CPAN

	# The output directory is only made when there is something to put in it;
	# with no tables selected the run goes straight to the summary
	my $failed = (@{$tables} ? $self->_make_output_dir() : $self)->_export_all($database, $tables);
	return set_return($failed ? $EXIT_FAILURE : $EXIT_OK, { %RUN_STATUS_SCHEMA });
}

# _check_database
# Purpose:        Make sure the database is a readable regular file.
# Entry Criteria: $database is a defined, non-empty path.
# Exit Status:    Returns $self for chaining; croaks otherwise.
# Side Effects:   stat()s the file; sets $!.
sub _check_database :Private {
	my ($self, $database) = @_;

	# The stat result is reused via "_" so the file is only examined once;
	# $! is captured straight away because later calls may overwrite it
	if(!-e $database) {
		$self->_croak_i18n('database_not_found', { params => [$database, "$!"] });
	}
	$self->_croak_i18n('database_not_file', { params => [$database] }) unless -f _;
	$self->_croak_i18n('database_unreadable', { params => [$database] }) unless -r _;

t/exporter.t  view on Meta::CPAN

	is($stderr, '', 'no warnings');
	like($logger->{lines}[-1], qr/INFO Processed 2 tables, 0 failed/, 'summary logged');
	like($logger->{lines}[0], qr/INFO Exported Customers => /, 'export logged');
};

subtest 'new files get normal permissions, not File::Temp 0600' => sub {
	plan(skip_all => 'Windows has no Unix permission bits') if $^O eq 'MSWin32';
	my $old = umask(022);
	my (undef, $out) = export(['Orders']);
	umask($old);
	is((stat(File::Spec->catfile($out, 'Orders.csv')))[2] & oct(777), oct(644), 'mode 0644 under umask 022');
};

subtest 'progress goes to STDERR' => sub {
	my ($status, undef, $stdout, $stderr) = export([qw(A B)], progress => 1);
	is($stdout, '', 'nothing on STDOUT');
	like($stderr, qr/^\[1\/2\] A\n\[2\/2\] B\n\z/, 'numbered progress');
};

subtest 'encodings' => sub {
	my (undef, $out) = export(['Unicode'], encoding => 'utf8');

t/function.t  view on Meta::CPAN

	}
	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';
};

t/transaction.t  view on Meta::CPAN

# 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');