view release on metacpan or  search on metacpan

t/clean.t  view on Meta::CPAN

#!perl
use 5.006;
use strict;
use warnings;
use Test::More;
use File::Temp qw(tempdir);
use File::Spec;

use App::FileCleanerByDiskUage;

# These tests avoid depending on the real disk usage percentage by using the
# two extremes:
#   du => 0   -> usage is always >= 0, so removal always triggers
#   du => 101 -> usage is always < 101, so removal never triggers
# This lets us deterministically exercise the ordering / min_files / ignore
# logic regardless of how full the underlying filesystem actually is.

# create a set of files with controlled, strictly increasing mtimes.
# returns the temp dir and an array ref of file names (oldest first).
sub make_files {
	my (@names) = @_;
	my $dir = tempdir( CLEANUP => 1 );
	my $mtime = 1_000_000;
	my @paths;
	foreach my $name (@names) {
		my $path = File::Spec->catfile( $dir, $name );
		open( my $fh, '>', $path ) or die("could not create $path: $!");
		print {$fh} "x\n";
		close($fh);
		utime( $mtime, $mtime, $path ) or die("could not utime $path: $!");
		push( @paths, $path );
		$mtime += 100;
	}
	return ( $dir, \@paths );
}

sub count_existing {
	return scalar grep { -e $_ } @_;
}

# -------------------------------------------------------------------------
# below threshold: nothing should be searched or removed
# -------------------------------------------------------------------------
{
	my ( $dir, $files ) = make_files(qw(a b c d e));
	my $r = App::FileCleanerByDiskUage->clean( path => $dir, du => 101 );

	is( $r->{unlinked_count},    0, 'below threshold: nothing unlinked' );
	is( count_existing(@$files), 5, 'below threshold: all files remain on disk' );
	is( scalar( @{ $r->{found_files} } ), 0, 'below threshold: found_files is empty (no search performed)' );
	is( $r->{du_starting}, $r->{du_ending}, 'below threshold: du_starting == du_ending' );
}

# -------------------------------------------------------------------------
# above threshold, no min_files: everything gets removed, oldest first
# -------------------------------------------------------------------------
{
	my ( $dir, $files ) = make_files(qw(a b c d e));
	my $r = App::FileCleanerByDiskUage->clean( path => $dir, du => 0 );

	is( $r->{found_files_count}, 5, 'du=0: found all five files' );
	is( $r->{unlinked_count},    5, 'du=0: all five files removed' );
	is( count_existing(@$files), 0, 'du=0: nothing left on disk' );

	# found_files must retain the full, sorted (oldest -> newest) list even
	# though the removal loop consumed everything.
	is( scalar( @{ $r->{found_files} } ), 5, 'du=0: found_files still holds all files' );
	my @found_mtimes = map { $_->{mtime} } @{ $r->{found_files} };
	is_deeply(
		\@found_mtimes,
		[ sort { $a <=> $b } @found_mtimes ],