clean.pl

#!/usr/bin/perl
######################################################################
# @(#)clean.pl 1.5.4 (leif@ogre.com) 05/20/96
#
# AUTHOR: Leif Hedstrom <leif@ogre.com>
#
# SYNOPSIS:
#    clean [ -adefmnpruvFT] [-i [yn]] [-s string] [names ...]
#
# HISTORY:
#    21-Jul-1991   Leif    Initial version
#    23-Mar-1992   Leif    Bugs, makeregexp, framemaker, -b option, ver 1.1
#     5-Apr-1992   Leif    Added -a and -n option, ver 1.2
#    26-Sep-1993   Leif    Added -u and cleaned man page, ver 1.3
#    25-Jan-1994   Leif    Fixed NFS mount points traversal, fixed a bug in
#                          answer, added -T, cleaned up, ver 1.4
#     5-Feb-1994   Leif    Added -m for deleted MH files, performance boost,
#                          ignore symbolic links, ver. 1.5
#    22-Oct-1994   Leif    Fixed %-bug, ver. 1.5.1
#    16-Jan-1995   Leif    Works with Perl ver. 5.000 now.
#    22-Jan-1995   Leif    Added `-c' option, and changed `%' matching.
#    20-May-1996   Leif    Added `-e' switch, to remove emacs .save files. I
#                          also moved the other emacs regexp's to $emexp.
#    14-Mar-2012   Leif    Wow, I've used this tool for 21 years... It finally
#                          broke, sort of, with the deprecation of getopts.pl.
#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
use Getopt::Std;

#
# Global variables.
#
$USAGE   = "clean [ -acdefmnprtvuFT] [-i [yn]] [-s string] [names ...]";
$stdexp  = '[^%]*\%$|^core$';
$emexp   = '^\.saves-[0-9]+|.*\~$|^\#.*\#$';
$texexp  = '.*\.(cp|fn|ky|pg|tp|vr|aux|log|toc|fns)$';
$sysexp  = '^\.nfs.*';
$framexp = '.*\.backup$|.*\.lck';
$mhexp   = '^[,#][0-9]+$';
%anslist = ('^[yY]([eE][sS])?$', 1, '^[Nn]([oO])?$', 0);

#
# Subroutines.
#
sub answer
{    # answer(STR prompt, STR default)
    local ($regexp);    # STR: Holds a reg. exp.
    local ($retval);    # INT: Return value of reg. exp.
    local ($value) = -1;    # INT: Calculated return value

    print $_[0];
    chop($_ = <>);
    $_ = $_[1] if /^$/o;    # Default choice
    while (($regexp, $retval) = each %anslist) {
        $value = $retval if $_ =~ /$regexp/;
    }
    return $value;
}

sub makeregexp
{                           # makeregexp(STR regexp)
    $_ = "^core$|" if $opt_c;
    $_ = "$stdexp|" if $opt_d || $opt_a;
    $_ .= "$texexp|"  if $opt_t || $opt_a;
    $_ .= "$framexp|" if $opt_f || $opt_a;
    $_ .= "$sysexp|"  if $opt_u || $opt_a;
    $_ .= "$mhexp|"   if $opt_m || $opt_a;
    $_ .= "$emexp|"   if $opt_e || $opt_a;
    $_ .= $_[0]       if $_[0];
    chop if !$_[0];

    $_ = $stdexp if $_ eq "";
    s/ //g;                 # Don't allow space in filenames
    $stdexp = $_;
    print "Searchstring is:  $stdexp\n" if $opt_v;
}

sub handledir
{                           # handledir(STR directory)
    local (@files);         # ARR[STR]: Files in directory

    if (opendir(thedir, $_[0]) == 0) {
        print STDERR "WARNING:can't access directory $_[0]\n";
        return 0;
    }
    print "Now processing directory \'$_[0]\'\n" if $opt_v;
    @files = readdir(thedir);    # No close, will be done on next open!
    grep(substr($_, 0, 0) = "$_[0]/", @files);
    foreach (@files) {
        next if /\/\.$/ || /\/\.\.$/;
        if (-d) {
            next if (-l && !$opt_F);
            next if (!$opt_T && ($org_dev != (stat(_))[0]));
            &handledir($_) if $opt_r;
        } else {
            &handlefile($_);
        }
    }
}

sub handlefile
{    # handlefile(STR file)
    $file = substr($_[0], rindex($_[0], "/") + 1);
    if ($file =~ /$stdexp/o) {
        print "$_[0]\n" if (!$opt_i && ($opt_p || $opt_v || $opt_n));
        return if $opt_n;
        if ($opt_i) {    # Interactive mode
            $key = -1;
            $key = &answer("Delete $_[0] [$opt_i]? ", "$opt_i") while $key < 0;
            return if ($key != 1);    # Don't remove anything!
        }
        unlink $_[0] || print STDERR "Could not delete $_[0]\n";
    }
}

#
# Here starts the main program.
#
unshift(@ARGV, split(/ /, $ENV{"CLEAN_OPTIONS"}));    # Env. options

&getopts('acdefmnprtuvFTi:s:') || die "Usage: $USAGE\n";
$opt_i = 'n' if (defined($opt_i) && $opt_i eq "");

&makeregexp($opt_s);

if ($#ARGV < $[) {
    ($org_dev) = stat(".");
    &handledir(".");
} else {
    foreach (@ARGV) {
        if (-f) {
            ($org_dev) = stat(".");
            &handlefile($_);
        } elsif (-d) {    # Recursive
            ($org_dev) = stat(_);
            &handledir($_);
        } else {
            print STDERR "$_: file not found!\n";
        }
    }
}