Added yet another patch by Chris Mason.

Added POD.

Changed option processing to use Getopt::Long and Pod::Usage.
This commit is contained in:
hjp 2003-05-14 11:49:56 +00:00
parent 22a6dba7b1
commit 2ce9f5b473
1 changed files with 84 additions and 19 deletions

View File

@ -1,15 +1,61 @@
#!@@@perl@@@ -w #!@@@perl@@@ -w
=head1 NAME
cleandir - remove unused files from directory
=head1 SYNOPSIS
cleandir [-d days] [-n] [-v] [-s] directory...
=head1 DESCRIPTION
cleandir recursively searches each directory given on the commandline
for files and subdirectories which have not been accessed for n days and
deletes them.
=head1 OPTIONS
=over 4
=item B<-d days>
Delete files which have not been accessed for the given number of days.
The default is 14.
=item B<-n>
No-op. Don't delete any files.
=item B<-v>
Verbose. Can be repeated to increase verbosity.
=item B<-s>
Skip sockets and named pipes. Some programs (notably X11 and some
databases) create sockets and named pipes in /tmp and foolishly expect
them to survive. This option exists to humour them.
=back
=head1 AUTHOR
Peter J. Holzer <hjp@hjp.at>. Thanks to Chris Mason for some
enhancements.
=cut
use strict; use strict;
use File::stat; use File::stat;
use POSIX; use POSIX;
use Getopt::Long;
use Pod::Usage;
my $verbose = 0; my $verbose = 0;
my $nop = 0; my $nop = 0;
my $skip_fifos = 0;
sub usage {
print STDERR "Usage: $0 [-d days] dir ...\n";
exit(1);
}
sub cleandir { sub cleandir {
my ($dir, $since, $level) = (@_); my ($dir, $since, $level) = (@_);
@ -33,7 +79,16 @@ sub cleandir {
my $st = lstat("$i"); my $st = lstat("$i");
# Skip anything on a different filesystem # Skip anything on a different filesystem
next if ($st->dev != $fs); if ($st->dev != $fs) {
$notremoved++;
next;
}
# Skip sockets and pipes
if ($skip_fifos && (-p $i || -S $i)) {
$notremoved++;
next;
}
if ($verbose > 3) { if ($verbose > 3) {
print STDERR "$0:", " " x $level, " mtime=", $st->mtime, " atime=", $st->atime, "\n"; print STDERR "$0:", " " x $level, " mtime=", $st->mtime, " atime=", $st->atime, "\n";
@ -98,29 +153,39 @@ sub cleandir {
sub main { sub main {
my $since = time() - 14 * 86400;; my $since = time() - 14 * 86400;;
my $i; my $i;
my $help;
GetOptions('help|?' => \$help,
'days|d=f' => sub { $since = time() - $_[1] * 86400; },
'verbose|v' => sub { $verbose++ },
'nop|n' => \$nop,
'skip-fifos|s' => \$skip_fifos,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(2) unless (@ARGV);
while ($i = shift(@ARGV)) { while ($i = shift(@ARGV)) {
if ($i eq "-d") {
my $days = shift(@ARGV);
$since = time() - $days * 86400;
} elsif ($i eq "-v") {
$verbose++;
} elsif ($i eq "-n") {
$nop++;
} else {
my $cwd = getcwd(); my $cwd = getcwd();
if (chdir($i)) { if (chdir($i)) {
cleandir($i, $since, 0); cleandir($i, $since, 0);
chdir($cwd); chdir($cwd);
} }
} }
}
exit(0); exit(0);
} }
main(); main();
# $Log: cleandir.pl,v $ # $Log: cleandir.pl,v $
# Revision 1.2 2002-02-25 23:33:29 hjp # Revision 1.3 2003-05-14 11:49:56 hjp
# Added yet another patch by Chris Mason.
#
# Added POD.
#
# Changed option processing to use Getopt::Long and Pod::Usage.
#
# Revision 1.2 2002/02/25 23:33:29 hjp
# Applied patch from "Chris L. Mason" <cmason@somanetworks.com> to prevent # Applied patch from "Chris L. Mason" <cmason@somanetworks.com> to prevent
# filesystem traversal. # filesystem traversal.
# #