File Coverage

blib/lib/Test/Dirs.pm

Criterion	Covered	Total	%
statement	105	118	88.9
branch	33	46	71.7
condition	12	20	60.0
subroutine	17	17	100.0
pod	3	3	100.0
total	170	204	83.3

package Test::Dirs;

use warnings;
use strict;

our $VERSION = '0.06';

use base 'Exporter';
our @EXPORT = qw(
    temp_copy_ok
    is_dir
    dir_cleanup_ok
);

use File::Temp;
use Test::Builder;
use File::Copy::Recursive 'dircopy';
use Carp 'confess';
use File::DirCompare;
use List::MoreUtils 'any';
use Text::Diff 'diff';
use Path::Class;
use File::Path 2.07 'remove_tree';
use Test::Harness;

our $test = Test::Builder->new;

sub temp_copy_ok {
	my $src_dir = shift or confess 'pass source folder as argument';
	my $message = shift || 'copy of '.$src_dir;

	if (not -d $src_dir) {
		$test->ok(0, $message);
		confess($src_dir.' is not a folder');
	}

	my $dst_dir = File::Temp->newdir();
	dircopy($src_dir, $dst_dir->dirname)
		or die 'failed to copy '.$src_dir.' to temp folder '.$dst_dir.' '.$!;
	$test->ok(1, $message);

	return $dst_dir;
}

sub is_dir {
	my $dir1 = shift or confess 'pass folders as argument';
	my $dir2 = shift or confess 'pass two folders as argument';
	my $message = shift || 'cmp '.$dir1.' with '.$dir2;
	my $ignore_ref = shift || [];
	my $verbose = shift;

	$verbose = $Test::Harness::Verbose
		unless defined($verbose);

	if ( $ENV{FIXIT} ) {
		dircopy( $dir1, $dir2 )
			or die 'failed to copy '
			. $dir1
			. ' to temp folder '
			. $dir2 . ' '
			. $!;
		$test->ok( 1, 'FIXIT: ' . $message );
		return;
	}

	my $have_two_folders = -d $dir1 && -d $dir2;
	unless ($have_two_folders) {
		$test->ok( -d $dir2, 'expected-param "' . $dir2 . '" is directory' );
		$test->ok( -d $dir1, 'is-param "' . $dir1 . '" is directory' );
		return;
	}

	my @ignore_files = @{$ignore_ref};
	my @differences;
	File::DirCompare->compare($dir1, $dir2, sub {
		my ($a, $b) = @_;
		my ($a_short, $b_short);

		if ($a) {
			$a_short = substr($a, length($dir1)+1);
			return if any { $_ eq $a_short } @ignore_files;
		}
		if ($b) {
			$b_short = substr($b, length($dir2)+1);
			return if any { $_ eq $b_short } @ignore_files;
		}

		if (not $b) {
			push @differences, 'Only in '.$dir1.': '.$a_short;
		} elsif (not $a) {
			push @differences, 'Only in '.$dir2.': '.$b_short;
		} else {
			push @differences, 'File "'.$a_short.'" differ';
			if ($verbose) {
				if (-f $a and -d $b) {
					push @differences, 'in '.$dir1.' is a regular file while in '.$dir2.' is a directory';
				}
				elsif (-d $a and -f $b) {
					push @differences, 'in '.$dir1.' is a directory while in '.$dir2.' is a regular file';
				}
				else {
					push @differences, diff($b, $a);
				}
			}
		}
	});

	if (not @differences) {
		$test->ok(1, $message);
		return;
	}

	$test->ok(0, $message);
	foreach my $difference (@differences) {
		$test->diag($difference);
	}
}

sub dir_cleanup_ok {
	my $filename = shift or confess 'pass filename as argument';
	my $message  = shift;

	$filename    = File::Spec->catfile(@{$filename})
		if (ref $filename eq 'ARRAY');
	if (-f $filename) {
		$filename = file($filename)->dir->stringify;
	}

	$message ||= 'cleaning up '.$filename.' folder and all empty folders up';

	my $removed_filenames;
	my $rm_err;
	remove_tree($filename, {result => \$removed_filenames, keep_root => 1, error => \$rm_err});
	if (@{$rm_err}) {
		$test->ok(0, $message);
		$test->diag("Error:\n", @{$rm_err});
		return;
	}
	@{$removed_filenames} = map { File::Spec->catfile($filename, $_)."\n" } @{$removed_filenames};

	# remove the file folder and all empty folders upwards
	while (rmdir $filename) {
		push @{$removed_filenames}, $filename."\n";
		$filename = file($filename)->parent->stringify;
	}

	$test->ok(1, $message);
	$test->diag("Removed:\n", @{$removed_filenames});
}


'A car is not merely a faster horse.';


__END__