Listing 2: cleantmp

Listing 2  cleantmp -- Perl source

#!/usr/bin/perl
#
# cleantmp -- delete files from /tmp and /usr/tmp
#    in accordance with Official Policy
#
require "getopts.pl";

do Getopts('vn') || die "Usage: $0 [-v] [-n]\n";
($#ARGV != -1) && die "Usage: $0 [-v] [-n]\n";
&clean("/tmp", 0);
&clean("/usr/tmp", 0);

sub clean {
local($dirname, $level) = @_;
print " " x (4 * $level),
"Cleaning directory '$dirname'\n" if $opt_v;
if (!opendir(DIRP, $dirname)) {
warn "opendir of $dirname failed: $!\n";
return 0;
}
local(@allfiles) = readdir(DIRP);
closedir(DIRP);
if (!chdir($dirname)) {
warn "chdir to $dirname failed: $!\n";
return 0;
}
local($entries) = 0;
for (@allfiles) {
next if $_ eq '.' || $_ eq '..';
local(@statbuf) = lstat($_);
if (-d _) {
local($subent) = &clean($_, $level + 1);
$deleteflag = ($subent == 0 && $statbuf[4] != 0);
if ($deleteflag && ! $opt_n) {
rmdir($_) || warn "rmdir failed on $_: $!\n";
}
else {
$entries++;
}
print " " x (4 * $level + 4),

"directory '$_' has $subent entries: ",
$deleteflag ? ($opt_n ? "would be" : "") :
($opt_n ? "would not be" : "not"),
" deleted\n" if $opt_v;
}
else { # it's a file, or something else
$age = -C _;
$deleteflag = ($level == 0 && $age > 1) ||
($level > 0 && $age > 3);
if ($deleteflag && ! $opt_n) {
unlink($_) || warn "unlink failed on $_: $!\n";
}
else {
$entries++;
}
print " " x (4 * $level + 4),

"file '$_' is $age days old: ",

$deleteflag ? ($opt_n ? "would be" : "") :
($opt_n ? "would not be" : "not"),
" deleted\n" if $opt_v;
}
}
chdir("..") ||
die "chdir to $dirname/.. failed: $!\n";
$entries;
}