view release on metacpan or  search on metacpan

t/clean.t  view on Meta::CPAN

# -------------------------------------------------------------------------
# ignore regexp: matching files are neither found nor removed
# -------------------------------------------------------------------------
{
	my ( $dir, $files ) = make_files( 'a.log', 'b.keep', 'c.log', 'd.keep' );
	my $r = App::FileCleanerByDiskUage->clean( path => $dir, du => 0, ignore => '\.keep$' );

	is( $r->{found_files_count}, 2, 'ignore: only non-ignored files found' );
	is( $r->{unlinked_count},    2, 'ignore: only non-ignored files removed' );

	ok( ( -e $files->[1] && -e $files->[3] ), 'ignore: .keep files preserved' );
	ok( ( !-e $files->[0] && !-e $files->[2] ), 'ignore: .log files removed' );
}

# -------------------------------------------------------------------------
# recursion: files in subdirectories are found and removed
# -------------------------------------------------------------------------
{
	my $dir = tempdir( CLEANUP => 1 );
	my $sub = File::Spec->catdir( $dir, 'nested' );
	mkdir($sub) or die("could not mkdir $sub: $!");
	my $mtime = 1_000_000;
	my @paths;
	foreach my $spec ( [ $dir, 'top' ], [ $sub, 'deep' ] ) {
		my $path = File::Spec->catfile( @$spec );
		open( my $fh, '>', $path ) or die("could not create $path: $!");
		print {$fh} "x\n";
		close($fh);
		utime( $mtime, $mtime, $path );
		push( @paths, $path );
		$mtime += 100;
	}

	my $r = App::FileCleanerByDiskUage->clean( path => $dir, du => 0 );
	is( $r->{found_files_count}, 2, 'recursion: found file in top dir and in subdir' );
	is( count_existing(@paths),  0, 'recursion: removed files from both levels' );
}

# -------------------------------------------------------------------------
# a symlinked top-level path is followed (relies on trailing-slash handling)
# -------------------------------------------------------------------------
SKIP: {
	my ( $real, $files ) = make_files(qw(a b));
	my $link = $real . '_link';
	skip( 'symlinks not supported here', 2 ) unless eval { symlink( $real, $link ) };

	# dry_run so the underlying files survive for the existence check
	my $r = App::FileCleanerByDiskUage->clean( path => $link, du => 0, dry_run => 1 );
	is( $r->{found_files_count}, 2, 'symlinked top path: files found through the symlink' );
	is( count_existing(@$files), 2, 'symlinked top path: dry run left files intact' );

	unlink($link);
}

# -------------------------------------------------------------------------
# missing paths are recorded, a valid path in the same call still works
# -------------------------------------------------------------------------
{
	my ( $dir, $files ) = make_files(qw(a b));
	my $missing = File::Spec->catdir( $dir, 'does_not_exist' );
	my $r = App::FileCleanerByDiskUage->clean( path => [ $dir, $missing ], du => 101 );

	is( scalar( @{ $r->{missing_paths} } ), 1, 'missing path recorded' );
	is( scalar( @{ $r->{path} } ),          1, 'valid path retained' );
}

# -------------------------------------------------------------------------
# dry_run: report what would be removed but leave everything on disk
# -------------------------------------------------------------------------
{
	my ( $dir, $files ) = make_files(qw(a b c));
	my $r = App::FileCleanerByDiskUage->clean( path => $dir, du => 0, dry_run => 1 );

	is( $r->{dry_run},           1, 'dry_run: flagged in results' );
	is( $r->{unlinked_count},    3, 'dry_run: reports all three as would-be removed' );
	is( count_existing(@$files), 3, 'dry_run: nothing actually removed from disk' );
}

# a non-writable file in a dry run is reported as a failure, not a removal.
# skipped when running as root, where -w is effectively always true.
SKIP: {
	skip( 'writability check is unreliable when running as root', 2 ) if $> == 0;

	my ( $dir, $files ) = make_files(qw(a));
	chmod( 0400, $files->[0] );
	skip( 'could not make file non-writable', 2 ) if -w $files->[0];

	my $r = App::FileCleanerByDiskUage->clean( path => $dir, du => 0, dry_run => 1 );

	is( $r->{unlink_failed_count}, 1, 'dry_run: non-writable file recorded as failure' );
	is( count_existing(@$files),   1, 'dry_run: non-writable file left on disk' );

	chmod( 0600, $files->[0] );    # so File::Temp can clean up
}

# -------------------------------------------------------------------------
# input validation dies
# -------------------------------------------------------------------------
eval { App::FileCleanerByDiskUage->clean( du => 0 ); };
ok( $@, 'dies when path is undef' );

eval { App::FileCleanerByDiskUage->clean( path => tempdir( CLEANUP => 1 ) ); };
ok( $@, 'dies when du is undef' );

eval { App::FileCleanerByDiskUage->clean( path => tempdir( CLEANUP => 1 ), du => 'abc' ); };
ok( $@, 'dies when du is non-numeric' );

eval { App::FileCleanerByDiskUage->clean( path => tempdir( CLEANUP => 1 ), du => 0, min_files => 'abc' ); };
ok( $@, 'dies when min_files is non-numeric' );

done_testing();