App-FileCleanerByDiskUage

 view release on metacpan or  search on metacpan

lib/App/FileCleanerByDiskUage.pm  view on Meta::CPAN

	#
	# Rather than calling df() after every single unlink (a statvfs syscall each
	# time, which dominates the loop on high latency filesystems), we estimate
	# how much space we still need to free from the block counts we already have
	# and only consult the real df() when the estimate says we should be close.
	# The real df() remains the authoritative stop condition, so this never
	# under removes; the $resync cap bounds how far a bad estimate (concurrent
	# writers, files held open elsewhere) can run us past the target.
	my $per = $df->{per};

	# bytes the user may occupy, used to translate a percentage into bytes. The
	# byte mode df() (block size of 1) reports used/bavail in bytes.
	my $df_bytes = $df_func->( $du_path, 1 );
	my $user_total = ( $df_bytes->{used} || 0 ) + ( $df_bytes->{bavail} || 0 );
	# estimated bytes still to free to reach the target, and bytes freed since
	# the last real df() check
	my $need  = ( ( $per - $opts{du} ) / 100 ) * $user_total;
	my $freed = 0;

	my $int             = 0;
	my $since_resync    = 0;

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) = @_;

t/removal_loop.t  view on Meta::CPAN

		print {$fh} ( 'x' x 100 );
		close($fh);
		utime( $mtime, $mtime, $path );
		push( @files, $path );
		$mtime++;
	}
	return ( $dir, \@files );
}

# make a mock df over $dir whose capacity is fixed at $capacity bytes. Usage is
# the summed allocated size of the files still present, so per == percent of the
# original files remaining. Counts its own calls via $$calls_ref.
sub mock_df_for {
	my ( $dir, $capacity, $calls_ref ) = @_;
	return sub {
		$$calls_ref++;
		my $used = 0;
		File::Find::find( sub { $used += ( ( stat($_) )[12] || 0 ) * 512 if -f _ }, $dir );
		my $bavail = $capacity - $used;
		$bavail = 0 if $bavail < 0;
		return {



( run in 1.560 second using v1.01-cache-2.11-cpan-7fcb06a456a )