"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 @_;
    }
}