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;
#!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 2.218 seconds using v1.01-cache-2.11-cpan-7fcb06a456a )