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;
}

