#### "Linux Gazette...making Linux just a little more fun!"

    #! /usr/bin/perl -w
    # cleantmp: Remove old files from /tmp partition
    # Copyright (C) 1997 by Guy Geens
    # Snail Mail:
    # Zwijnaardsesteenweg 183
    # 9000 Gent
    # Belgium

    use File::Find;

    $tmpdir = '/tmp/';
    chdir ($tmpdir) || die "$tmpdir not accessible: $!";
    if ($> == 0) {			# Is euid == 0?
        $test = 0;
    } else {
    # Not run by root - test only
        $test = 1;
    }

    @list = ();

    &find(\&do_files, $tmpdir);
    &find(\&do_dirs, $tmpdir);

    if (@list) {
        print "Cleaned $tmpdir\n";
        print "Deleted files are:\n";
        for (sort @list) {
    	print "$_\n";
        }
    }

    exit;

    sub do_files {
        (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
    	(-f _ || -l _ ) &&
    	    (int(-C _) > 3) &&
    		! ((/^\.X.*lock$/ || /^quota\.user$/ || /^quota.group$/)
    		   && $uid == 0) &&
    		       &removefile ($_) && push @list, $File::Find::name;
    }

    sub do_dirs {
        (/^\..*-unix$/ && $uid ==0) && ($File::Find::prune = 1) ||
    	(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
    	    -d _ && ($nlink == 2) &&
    		! (/^lost\+found$/ && $uid == 0) &&
    		    &removedir ($_) && push @list, "$File::Find::name/";
    }

    sub removedir {
        if ( $test ) {
    	1;
        } else {
    # Can't use @_: rmdir doesn't take a list argument
    	rmdir $_[0];
        }
    }

    sub removefile {
        if ( $test ) {
    	1;
        } else {
    	unlink @_;
        }
    }

##### Copyright © 1997, Guy Geens
Published in Issue 20 of the Linux Gazette, August 1997