view release on metacpan or  search on metacpan

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

	# File tests, evals and child processes below would otherwise leave
	# their marks in the caller's $@ and $!
	local ($@, $!);

	# An undef database is a missing one, not a file called "".  Work on a
	# copy: get_params hands back the caller's own hash when given one.
	# (Params::Get either dies or returns a hash reference - proved in
	# t/path.t - so no test of what it returned is needed.)
	my $input = { %{ get_params('database', \@_) } };
	delete $input->{database} unless defined $input->{database};
	my $params = validate_strict(
		schema => { database => { type => 'string', min => 1 } },
		input  => $input,
	);
	my $database = $params->{database};

	# Fail fast, before any output, on problems that affect every table
	$self->_check_database($database)
		->_verify_dependencies()
		->_reset_names();

	# Stopping part-way must behave like a failed transaction: the table
	# being exported is discarded (its temporary file deleted) and no
	# further table is started.  Perl's default action for these signals
	# is to exit at once, skipping the clean-up, so while run() is active
	# they raise an exception instead.  A handler the caller has set is
	# left alone; everything is restored when run() returns.
	local $self->{interrupted};
	my @ours = @{ $self->_interrupt_signals() };
	local @SIG{@ours} = (sub {
		$self->{interrupted} = $_[0];
		die $self->_printable($self->i18n('interrupted', { params => [$_[0]] })), "\n";
	}) x @ours;

	# Premise: the database is now known to be a readable regular file, and
	# it is only ever passed to mdbtools as one list argument after "--".
	# Conclusion: it is safe to untaint.
	$database = _untaint($database);

	my $tables = $self->_select_tables($self->_get_tables($database));

	# Guard clause: a dry run must not touch the file system, so it leaves
	# before mkdir.  Premise: _dry_run writes nothing that can fail a table.
	# Conclusion: a dry run always succeeds.
	if($self->{dry_run}) {
		$self->_dry_run($database, $tables);
		return set_return($EXIT_OK, { %RUN_STATUS_SCHEMA });
	}

	# 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 _;

	return $self;
}

# _verify_dependencies
# Purpose:        Locate the mdbtools programs in PATH.
# Entry Criteria: None.
# Exit Status:    Returns $self; croaks if a required program is missing.
# Side Effects:   Sets $self->{programs}; may switch off show_counts (with a
#                 warning) when mdb-count is unavailable; logs at debug level.
sub _verify_dependencies :Private {
	my $self = shift;

	my %programs;
	foreach my $program (@REQUIRED_PROGRAMS) {
		$programs{$program} = $self->_find_program($program)
			or $self->_croak_i18n('program_missing', { params => [$program] });
	}

	# mdb-count is only needed for row counts, so its absence is not fatal.
	# _find_program returns a path or false, so one branch decides both
	# "store it" and "switch counts off" (nothing is stored and removed).
	if($self->{show_counts}) {
		if(my $path = $self->_find_program($MDB_COUNT)) {
			$programs{$MDB_COUNT} = $path;
		} else {
			$self->{show_counts} = 0;
			$self->_warn('no_row_counter');
		}
	}

	$self->{programs} = \%programs;
	return $self;
}

# _find_program
# Purpose:        Look up one program in PATH and note where it was found.
# Entry Criteria: $program is a bare program name.
# Exit Status:    Returns the full path, or undef if not found.
# Side Effects:   Logs the location at debug level when --verbose is on.
sub _find_program :Private {
	my ($self, $program) = @_;

	# Only absolute paths are trusted.  A relative entry in PATH (".", or
	# an empty one) would run whatever file of that name is in the current
	# directory - a classic way to plant a program.
	my ($path) = grep { defined && File::Spec->file_name_is_absolute($_) } which($program);

	# An absolute path to an existing program: safe to untaint
	$path = _untaint($path) if defined $path;