package t::lib::functions;
# Pragmas
use strict;
use warnings;
# Modules
use Data::Downloader::DB;
use File::Basename;
use File::Path;
use File::Slurp;
use File::Spec::Functions qw(canonpath catfile catdir curdir rel2abs);
use File::Temp qw(tempdir);
use FindBin qw($Bin);
use Test::More;
use base 'Exporter';
# Exported functions
our @EXPORT = qw(ok_system ok_not_system
scratch_dir set_path t_copy test_cleanup);
# Test system command
sub ok_system {
my $cmd = shift;
ok(system($cmd) == 0, $cmd)
or diag "$cmd failed : $? ${^CHILD_ERROR_NATIVE}";
}
sub ok_not_system {
my $cmd = shift;
ok(system($cmd) != 0, $cmd) or diag "$cmd exited with $?";
}
# Create scratch directory for testing
sub scratch_dir {
my %opts = @_;
my $scratchdir;
if (my $tmpdir = $ENV{DATA_DOWNLOADER_TMPDIR}) {
$scratchdir = tempdir("dado_test_$<_XXXXXX",
DIR => $tmpdir, UNLINK => 0, %opts);
} else {
$scratchdir = catdir($Bin, 'dado_test');
}
unless (-d $scratchdir) {
mkpath($scratchdir) or BAIL_OUT "Unable to make dir $scratchdir: $!";
}
return rel2abs($scratchdir);
}
# Set path for scripts
sub set_path {
my $perldir = dirname `which perl`;
$ENV{PATH} = "$Bin/../blib/script:$perldir:/usr/local/bin:/usr/bin:/bin";
warn "# modifying PERL5OPT for tests ($ENV{PERL5OPT})" if $ENV{PERL5OPT};
$ENV{PERL5OPT} = "-Mblib=$Bin/../blib";
return $ENV{PATH};
}
# Copy file to t directory and modify it
sub t_copy {
my $old_file = shift(@_) or BAIL_OUT "Missing old file in t_copy()";
my $from = shift(@_) or BAIL_OUT "Missing 'from' string in t_copy()";
my $to = shift(@_) || scratch_dir();
my $new_file = rel2abs(catfile($Bin, basename($old_file)));
my $content = read_file($old_file)
or BAIL_OUT "Unable to read old file $old_file: $!";
$content =~ s{$from}{$to}g;
write_file($new_file, $content)
or BAIL_OUT "Unable to write new file $new_file: $!";;
return $new_file;
}
# Clean up test directories and database files
sub test_cleanup {
my ( $dir, $db ) = @_;
rmtree( $dir, {
keep_root => ( $ENV{DATA_DOWNLOADER_TMPDIR} ? 0 : 1 ),
safe => 1
}
) if ( $dir && -d $dir );
$db ||= Data::Downloader::DB->new();
my $db_file = $db->database;
return 1 if $db_file eq ':memory:';
foreach my $file ( $db_file, $db_file . '.dado_stats_lock' ) {
unlink($file) if -e $file;
}
return 1;
}
1;