21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
31 First attempt believed that one would remove old files and then remove
32 directories. But we have plenty of old files that must not be deleted:
33 whenever a cpan shell has just unpacked a tarball, all these files
36 Second attempt used find instead of finddepth and pruned directories
37 that were in use according to fuser. Additionally it required them to
38 be older than a day. And required files too to be older than a day to
39 be deleted. BUT: I forgot reloperl which must be kept intact
40 completely. E.g. /tmp/basesmoker-reloperl-cGFh
44 # die "BROKEN, DO NOT USE";
46 use English
qw( -no_match_vars ) ;
48 die sprintf "ALERT: effective uid %d not allowed\n", $EFFECTIVE_USER_ID if $EFFECTIVE_USER_ID==0;
50 use Time
::HiRes
qw(sleep);
53 use lib
"$FindBin::Bin/../lib";
59 use File
::Basename
qw(dirname);
60 use File
::Path
qw(mkpath);
61 use File
::ReadBackwards
;
65 use Hash
::Util
qw(lock_keys);
66 use List
::Util
qw(reduce);
67 use Pod
::Usage
qw(pod2usage);
68 use Proc
::ProcessTable
;
71 lock_keys
%Opt, map { /([^=!\|]+)/ } @opt;
85 my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime) = lstat($File::Find
::name
);
87 my($r) = readlink $File::Find
::name
;
88 warn "symlink: $File::Find::name => $r\n";
89 } elsif (! defined $mtime) {
91 } elsif ("/tmp" eq $File::Find
::name
) {
93 } elsif ( $File::Find
::name
=~ /tmp\/basesmoker
-reloperl
/ ) {
95 $File::Find
::prune
= 1;
96 } elsif ( $File::Find
::name
=~ /tmp\/loop_over_bdir
/ ) {
98 $File::Find
::prune
= 1;
99 } elsif ( $File::Find
::name
=~ /tmp\/perl
-clone
-\d
/ ) {
101 $File::Find
::prune
= 1;
102 } elsif ( $File::Find
::name
=~ /tmp\/CPAN
-Reporter
-/ ) {
104 $File::Find
::prune
= 1;
106 warn "About to run fuser on '$File::Find::name\n";
107 open my $fh, "-|", fuser
=> $File::Find
::name
or die;
110 my($file, $proc) = split " ", $_;
113 $File::Find
::prune
= 1;
116 if ($mtime+86400 < $^T
) {
117 warn "keeping fresh directory: $File::Find::name ($^T)";
119 warn "directory in use: $File::Find::name\n";
120 } elsif (rmdir($File::Find
::name
)) {
121 warn "rmdir: $File::Find::name\n";
122 $File::Find
::prune
= 1;
124 warn "no rmdir: $File::Find::name ($!)";
127 } elsif ($mtime+86400 < $^T
) {
128 warn "About to run fuser on day old '$File::Find::name\n";
129 open my $fh, "-|", fuser
=> $File::Find
::name
or die;
132 my($file, $proc) = split " ", $_;
136 warn "file in use: $File::Find::name\n";
137 } elsif (unlink($File::Find
::name
)) {
138 warn "unlink: $File::Find::name\n";
140 warn "no unlink: $File::Find::name ($!)";
143 my $secs_old = $^T
-$mtime;
144 # warn "keeping too young file: $File::Find::name ($secs_old seconds old)\n";