#!/usr/local/bin/perl -w

#@(#) Olivier Aubert 1 october 1994 <Olivier.Aubert@enst-bretagne.fr>
#@(#) Account cleaner

##########
### Clean.
### (c) 1997 Olivier.Aubert@enst-bretagne.fr
### This program is GPLed (see http://www.gnu.org/copyleft/gpl.html).
### To get the doc, run a pod converter (pod2man, pod2text, pod2latex)
### on this file.
####################################################################### 

package Clean;
require 5.000;
use FileHandle;
use strict;
no strict 'subs';

# Misc
($Clean::version) = (q$Revision: 4.57 $ =~ /Revision:\s+([\d]+\.[\d]+)/);

# Debug variables. Should not be put in set_default_options, so that
# once set, they keep set even if the -d option is given.
$Clean::codedump        = 0;  # Debug (prints generated code and exits)
$Clean::debugmode       = 0;  # Prints each studied file

# vt100 codes
$Clean::bold = "\e[1m";
$Clean::norm = "\e[0m";

# Configuration variables
@Clean::gzip_prg  = qw( /bin/gzip -9 -q );
@Clean::strip_prg = qw( /usr/bin/strip );
@Clean::file_prg  = qw( /usr/bin/file );
# Directories needing cleaning
@Clean::dir = ();

# Protect the user from a bad .cleanrc
# If a regexp included in the list is read from the .cleanrc file,
# the program stops and warns the user.
@Clean::exclude_regexp  = qw(
                             .*
                             .+
                               \..*
                             \..+
                             \..*rc
                             \..+rc
                            );

# Handling of long option names
# Options with : take an optional argument
# Options with = take a mandatory argument
%Clean::long_options = qw(
                          all a
                          check-only c
                          default d
                          delete-empty-dir e
                          output f:
                          gentle g:
                          help h
                          interactive i
                          empty-junk-dir j
                          follow-symbolic-links l
                          mode m=
                          no-recursion n
                          options o
                          process-todo-file p
                          generate-report r
                          silent s
                          quiet s
                          unprotect u
                          standard-output v
                          with-warnings w
                          strip-executables x
                          zap-invalid-links z
                          version V
                          debug D
                          code-dump C
                         );

####
## Sets the default values for options
## Input: none
## Output: none
####
sub set_default_options
{
  $Clean::protect         = 0;         # Are there any protected directories ?
  $Clean::default_priority = 10;       # Priority to use if -g is specified alone
                                       # Note: does not work with SunOS5.x
                                       # for setpriority() is not implemented
  $Clean::gzip_limit_size = 512;       # Do not gzip files
                                       # if size < $gzip_limit_size
  $Clean::total_size      = 0;         # Size of all files
  $Clean::delete_size     = 0;         # Size of deleted files
  $Clean::zip_size        = 0;         # Size saved by zipping files
  $Clean::strip_size      = 0;         # Size saved by stripping files
  $Clean::sortie         = "&STDOUT";  # Output to STDOUT
  $Clean::all_option     = 0;          # (off) Delete files specified with ALL=
  $Clean::verify         = 0;          # Only prints the actions to do
  $Clean::process_todo_file = 0;       # Processes the todo file
  $Clean::followlinks    = 0;          # Do not follow symbolic links (default)
  $Clean::delete_links   = 0;          # Delete invalid symbolic links
  $Clean::interactive    = 0;          # No confirmation (default)
  $Clean::report         = 0;          # Report on size (default)
  $Clean::recurse        = 1;          # Do subdirectory recursion
  $Clean::stripping      = 0;          # Stripping (default)
  $Clean::codedump       = 0;          # (off) Debug (prints $codes and exits)
  $Clean::debugmode      = 0;          # (off) Prints each file he studies
  $Clean::del_empty_dir  = 0;          # Delete empty directories
  $Clean::write_check    = 0;          # Checks for too permissive file perms
  $Clean::gentle         = 0;          # Renice the process
  $Clean::print_options  = 0;          # print options and exits
  $Clean::max_errors     = 1;          # Max number of errors in config file
  $Clean::empty_junk_dir = 0;          # Do not empty junk dirs
  $Clean::strip_age      = -1;         # No age checking by default
  $Clean::default_prg    = '/bin/false'; # Replacement program if file, gzip
                                         # or strip cannot be found.
  $Clean::history_file   = $ENV{'HOME'}.'/.clean-history';
  $Clean::write_umask    = 0022;

  # FIXME: Could be adapted, or checked against potentially dangerous
  # directories.
  @Clean::search_path = split(":", $ENV{'PATH'});
  
  # Display routines.
  # Not very useful for the moment, but it could evolve.
  %Clean::display = (
                     'STD',     sub { $Clean::sortiefh->print(@_); },
                     'ERROR',   sub { $Clean::sortiefh->print('ERROR: ', @_, "\n");
                                      exit(1); },
                     'SECURITY', sub { $Clean::sortiefh->print('!!! SECURITY !!! ', @_); },
                     'WARNING', sub { $Clean::sortiefh->print('!!! WARNING !!! ', @_); },
                     'INFO',    sub { $Clean::sortiefh->print(@_); },
                     'INTER',   sub { $Clean::sortiefh->print(@_); },
                     'DEBUG',   sub { $Clean::sortiefh->print('*** ', @_); },
                    );

  # hide_message is a hash table index by display level names.
  # The values are references to lists of regexps.
  # The messages should not be displayed if they match the regexp.
  %Clean::hide_message = map( ($_, []), keys %Clean::display);
}

####
## Generates the wrapper for hidden display routines.
## Input: a couple (reference to the original sub and the regexp list)
## Output: a sub reference
## Note: we use here closures. Refer to the explanation by Tom Christiansen
## (it can be found on http://www.perl.com/) to understand how it works.
####
sub generate_hiding_wrapper
{
  my $original = shift;
  my @regexp = @_;
  my $reg;
  my $code;

  for $reg (@regexp)
  {
    # Regexp match everything.
    return sub { } if ($reg eq "") or ($reg eq ".+") or ($reg eq ".*");
  }

  if (scalar(@regexp) == 1)
  {
    my $reg = $regexp[0];
    
    return sub {
      my $mess = join("", @_);
      
      return if ($mess =~ /$reg/i);
      # Call the original display routine
      &$original(@_);    
    }
  }
  else
  {
    return sub {
      my $mess = join("", @_);
      my $r;
      
      for $r (@regexp)
      {
        return if ($mess =~ /$r/i);
      }
      &$original(@_);    
    }
  }
}

####
## Updates the display routines according to the contents
## of %Clean::hide_message
## Input: none (uses the global variable)
## Output: none (modifies %Clean::display)
####
sub update_display_routines
{
  my $level;
  my @hide;
  my $original_routine;
  
  for $level (keys %Clean::display)
  {
    # You can't hide INTER messages.
    next if ($level eq "INTER");

    @hide = @{$Clean::hide_message{$level}};
    if (scalar @hide != 0)
    {
#      print "Generating wrapper for $level: @hide\n";
      
      $original_routine = $Clean::display{$level};
      $Clean::display{$level} = &generate_hiding_wrapper($original_routine,
                                                        @hide);
    }
  }

  
}

####
## Display a bug report form
## Input: array of lines describing the bug
## Output: nothing, just dies
####
sub bug_report
{
  print "Error: ", join("\n", @_), "\n";
  
  print <<'EOF';
  
Please send a bug report to Olivier.Aubert@enst-bretagne.fr

EOF
  exit(1);
}

####
## Manages the displaying of information based on the level given
## Input: the level (DEBUG, ERROR, STD, INTER, INFO, WARNING, SECURITY)
##        the data that should be displayed
## Output: none
####
sub message
{
  my $level = shift;

  if (! defined $Clean::display{$level})
  {
    &bug_report ("No display routine is defined for the $level level.");
  }
  else
  {
    &{$Clean::display{$level}}(@_);
  }
}

####
##  Search for different programs in the PATH
##  Input: executable name (alone or absolute, without any options)
##  Output: correct absolute name (or /bin/false if not found)
####

sub search_path
{
  my($file) = shift;
  my($basename);
  my($result) = $file;
  my $dir;

  if ( ! -x $file )
  {
    $result = "";
    
    ($basename) = ($file =~ /([^\/]+)$/);
    
    for $dir ( @Clean::search_path )
    {
      if ( -x $dir . "/" . $basename )
      {
        $result = $dir . "/" . $basename;
        last;
      }
    }
    
    if ($result eq "")
    {
      &message('WARNING', "unable to find ", $basename,
               " -- Defaulting to $Clean::default_prg.\n");
      $result = $Clean::default_prg;
    }
  }
    
  $result;
}

####
## Checks for the existence of the gzip, file and strip programs
## Input: none
## Output: none
####

sub check_progs
{
  my($dir)         = "";
  my($basename)    = "";
  my($options)     = "";
  my $prog;
  
  $Clean::gzip_prg[0]  = &search_path($Clean::gzip_prg[0]);
  
  $Clean::file_prg[0]  = &search_path($Clean::file_prg[0]);
  
  $Clean::strip_prg[0] = &search_path($Clean::strip_prg[0]);
  
  # One last check...
  
  for $prog ( $Clean::gzip_prg[0], $Clean::file_prg[0], $Clean::strip_prg[0] )
  {
    if ( ! -x $prog )
    {
      # Can't happen (see the jargon file...)
      die "Error: the program ", $basename,
      " does not exist.\nCorrect the path for it in your .cleanrc file\n";
    }
  }
  
}

####
## Create a .cleanrc file
## Input: absolute name of the config file
## Output: none
####
sub create_config_file
{
  my $conf = shift;

  open(RC, ">$conf") or die "Cannot create $conf file: $!\n";

  # Standard header stating the version of clean that created the file
  # The . around localtime(time) are mandatory to make it execute in a
  # scalar context and return a formatted string
  print RC "\#\# .cleanrc file created by clean ", $Clean::version,
  "\n\#\# on " . localtime(time) . "\n";
  
  print RC <<"EOF";
# Note: do *NOT* delete the previous two lines, clean relies on them

# Runtime options. Arguments (for -f, -g, ...) should not contain
# whitespaces.
# Current options: strip executables, produce a report, print warnings,
#                  empty junk dirs
OPTIONS=-x -r -w -j 

# Customization

# Used to determine wether a file is stripped or not
# Default : @Clean::file_prg
EOF
;

  # We generate the adequate FILE_PRG, STRIP_PRG and ZIP_PRG lines here
  # so that the program does not have to look for them at each invocation.

  if (-x $Clean::file_prg[0])
  {
    print RC "#FILE_PRG=\n";
  }
  else
  {
    $Clean::file_prg[0] = &search_path ($Clean::file_prg[0]);
    print RC "FILE_PRG=@Clean::file_prg\n";
  }

print RC <<"EOF";

# Used to strip non-stripped files
# Default : @Clean::strip_prg
EOF

  if (-x $Clean::strip_prg[0])
  {
    print RC "#STRIP_PRG=\n";
  }
  else
  {
    $Clean::strip_prg[0] = &search_path ($Clean::strip_prg[0]);
    print RC "STRIP_PRG=@Clean::strip_prg\n";
  }

print RC <<"EOF";

# Used to compress files
# Default : @Clean::gzip_prg
EOF

  if (-x $Clean::gzip_prg[0])
  {
    print RC "#ZIP_PRG=\n";
  }
  else
  {
    $Clean::gzip_prg[0] = &search_path ($Clean::gzip_prg[0]);
    print RC "ZIP_PRG=@Clean::gzip_prg\n";
  }

print RC <<'EOF';

# Put below the regexps corresponding to the files you want to delete
# and their maximum age (in days). -1 or nothing if age does not matter.
# If you want a regexp that matches a space, use \s.
# BE CAREFUL: regexps are perl styled. Refer to the perlre (1) manpage
# or to your local perl guru for help.

# Files to delete

# backup files
DEL=.+~
DEL=.+%
DEL=#.+#
DEL=\.saves-\d+-.+
DEL=.+\.[Bb][Aa][Kk]
DEL=textedit\..+

# core files
DEL=core
DEL=\.nfs.*

# LaTeX files
DEL=.+\.bbl
DEL=.+\.blg
DEL=.+\.aux
DEL=.+\.log
DEL=.+\.lof
DEL=.+\.toc
DEL=.+\.dvi     3

# eldo files
DEL=.+\.cui
DEL=.+\.chi
DEL=.+\.cou
DEL=.+\.edi

# asm files
DEL=.+\.bnd
DEL=gkserr.dat

# caml files
DEL=.+\.zi
DEL=.+\.zo

# misc
DEL=dead.letter
DEL=\.ControlCo\d+

# Files to delete only when the -a (all) option is set
DELOPT=.+\.o    # no more objects

# Directories to delete (regexps)
DELDIR=\.xvpics      # created by xv

# Files to compress (regexps)
ZIP=.+\.e?ps    10    # old ps or eps 
ZIP=.+\.tar           # tar files
ZIP=.+\.shar          # shar files

# Files to compress only when the -a (all) option is set
#ZIPOPT=.+\.c 5 # gzip c files older than 5 days

# If set, clean will only strip executables older than STRIP_AGE
# when invoked with -x
#STRIP_AGE=3

# Directories to empty when the -j option is set.
# One directory name for each line (NOT regexps).
# ~ is expanded to home directory.
EMPTYDIR=~/.dt/Trash        # for the dtfile luser.
EMPTYDIR=~/.netscape/cache     # for the netscape user.
EMPTYDIR=/usr/tmp 3            # for the usual UNIX user. Delete only files
                               # older than 3 days.
EMPTYDIR=/tmp                  # idem

# Protected directories.
# One directory name for each line (NOT regexps).
# ~ is expanded to home directory.
#PROTECT=~/my/current/project

# Default history file (used by the -f option). ~ is expanded to home
# directory. 
#HISTORY_FILE=~/.clean-history

# Other options exist, but if you want to know what they are, you'll have
# to read the manpage (do "perldoc clean" to get it).

EOF

  close(RC);

  if ($Clean::file_prg[0] eq $Clean::default_prg)
  {
    &message('WARNING', "I could not find the 'file' program in your PATH. Defaulting to $Clean::default_prg\n");
  }
  if ($Clean::gzip_prg[0] eq $Clean::default_prg)
  {
    &message('WARNING', "I could not find the 'gzip' program in your PATH. Defaulting to $Clean::default_prg\n");
  }
  if ($Clean::strip_prg[0] eq $Clean::default_prg)
  {
    &message('WARNING', "I could not find the 'strip' program in your PATH. Defaulting to $Clean::default_prg\n");
  }
}


#####
## Canonizes a directory name (essentialy .. removal)
## Input: directory name
## Output: canonized directory name
#####
sub canonize_directory_name
{
  my $dir = shift;

  if ($dir =~ m!^/\.\./!)
  {
    # Clearly an error...
    &message('ERROR', "$dir is an invalid directory.\n");
  }

  if ($dir !~ m!^/!)
  {
    $dir = $Clean::pwd . "/$dir";;
  }
  
  $dir =~ s!//+!/!g;
  $dir = "/$dir/";       #"sentinels"
  
  1 while $dir =~ s!/[^/]+/\.\./!/!g;

  1 while $dir =~ s!/\./!/!g;
  
  chop($dir = substr($dir, 1));
  return $dir;
}

#####
## Given a space separated string, extracts the options
## Defined options: (refer to the man file to have their meaning)
## a c d e f h i j l m n o p r s u v w x z C D V
## Unused (for now) options: b g k q t y
## Input: command line to parse (reference to array)
##        integer saying wether we get the command line from the real command
##        line or from the config file. In this case, we won't process the
##        -mmode option
## Output: none
#####
sub parse_options
{
  my(@options) = @{$_[0]};
  my $already_in_config_file = $_[1] || 0;
  my $long_help = 0;  
  my($commande);
  my($cluster);
  my(@flags);
  my($dir);
  
  while ($cluster = shift(@options))
  {
    if ($cluster !~ /^-/)
    {
      # If it's not an option, then it's a parameter (dir. name)
      $dir = &canonize_directory_name($cluster);
      push(@Clean::dir, &canonize_directory_name($dir));
      next;
    }

    # Long option names handling : we convert them to the equivalent
    # short option. Should do the opposite way, it is more extensible.
    if ($cluster =~ /^--(.*)/)
    {
      my $long = $1;

      if ($long =~ /^([^=]+)=(.*)$/)
      {
       $long = $1;
       $commande = $2;
      }
      else
      {
        $commande = '';
      }
      
      if (! defined $Clean::long_options{$long})
      {
        &message ('ERROR', "Unknown long option : $long\n");
      }
      else
      {
        my $opt;

        if ($long eq 'help')
        {
          $long_help = 1;
        }
        
        $opt = $Clean::long_options{$long};
        if ($opt =~ /=$/)
        {
          chop($opt);
          # Mandatory argument
          if (! $commande)
          {
            &message ('ERROR', "The option '$long' needs an argument\n");
          }
          $opt .= $commande;
        }
        elsif ($opt =~ /:$/)
        {
          # Optional argument
          chop($opt);
          $opt .= $commande;
        }        
        $cluster = '-' . $opt;
      }
    }
    
    @flags  = split(//, $cluster);
    shift(@flags);              # Remove the leading -
    
    while ($commande = shift(@flags))
    {
      if ($commande eq "a") # "All" option
      {
        if ($already_in_config_file)
        {
          &message('WARNING', "The -a (all) option cannot be set in a config file. I will ignore it.\n");
          next;
        }
        $Clean::all_option = 1;
        push(@Clean::list_erase, @Clean::list_erase_opt);
        push(@Clean::list_gzip,  @Clean::list_gzip_opt);
      }
      elsif ($commande eq "c")  # Checking only
      {
        $Clean::verify      = 1;
        $Clean::interactive = 0;
      }
      elsif ($commande eq "d")  # Default options
      {
        &set_default_options;
      }
      elsif ($commande eq "e") # Delete empty directories
      {
        $Clean::del_empty_dir = 1;
      }
      elsif ($commande eq "f") # Output to a file
      {
        $commande = join("", @flags);
        undef @flags;
        
        if ($commande eq "")    # Default output file
        {
          $Clean::sortie = $Clean::history_file;
        }
        else
        {
          $commande =~ s!^\~/!$Clean::home/!;
          if ($commande eq '-')
          {
            $Clean::sortie = '&STDOUT';
          }
          elsif ($commande =~ /^\//) # Absolute pathname
          {
            $Clean::sortie = $commande;
          }
          else
          {
            $Clean::sortie = $Clean::pwd . "/" . $commande;
          }
        }
      }
      elsif ($commande eq "g")  # "Gentle" option
      {
        # We get only the numbers that follow the flag. Other flags
        # can be specified after them.
        if (join('', @flags) =~ /(\d+)(.*)/)
        {
          $Clean::gentle = $1;
          @flags = split(//, $2);
        }
        else
        {
          # No priority number was specified. We use the default one.
          $Clean::gentle = $Clean::default_priority;
        }
        
        eval { setpriority(0, 0, $Clean::gentle); };
        if ($@)
        {
         &message('WARNING', "setpriority does not seem to be implemented on this platform\n");
        } 
      }
      elsif ($commande eq "h")  # Help
      {
        &help($long_help);
      }
      elsif ($commande eq "i")  # Interactive
      {
        $Clean::interactive = 1;
        $Clean::sortie      = "&STDOUT";
      }
      elsif ($commande eq "j")  # Empties junk directories
      {
        $Clean::empty_junk_dir   = 1;
      }
      elsif ($commande eq "l")  # Followlinks
      {
        $Clean::followlinks = 1;
      }
      elsif ($commande eq "m")  # New mode
      {
        $commande = join("", @flags);
        undef @flags;
        
        # Ignore this option if we're already reading a config file
        next if ($already_in_config_file == 1);

        # A parameter must be specified
        if ($commande eq "")
        {
          &message ('ERROR', "The option 'm' needs an argument\n");
        }
        
        $Clean::config_file .= "-" . $commande;
        
        if (! -r $Clean::config_file)
        {
          &message('ERROR', "the alternate config file ", $Clean::config_file, " does not exist.\n");
          exit(1);
        }
        
        &read_config_file($Clean::config_file);
      }
      elsif ($commande eq "n")  # No directory recursion
      {
        $Clean::recurse = 0;
      }
      elsif ($commande eq "o")  # Print options
      {
        $Clean::print_options = 1;
      }
      elsif ($commande eq "p")  # Process todo file
      {
        $Clean::process_todo_file = 1;
        $Clean::verify            = 0;
      }
      elsif ($commande eq "r")  # Display report
      {
        $Clean::report = 1;
      }
      elsif ($commande eq "s")  # No output
      {
        $Clean::sortie = "/dev/null";
      }
      elsif ($commande eq "u")  # Disable dir. protection
      {
        $Clean::protect = 0;
      }
      elsif ($commande eq "v")  # Verbose (output to STDOUT)
      {
        $Clean::sortie = "&STDOUT";
      }
      elsif ($commande eq "w")  # Checks for too permissive file perms
      {
        $Clean::write_check = 1;
      }
      elsif ($commande eq "x")  # Strip files
      {
        $Clean::stripping = 1;
      }
      elsif ($commande eq "z")  # Delete invalid links
      {
        $Clean::delete_links = 1;
      }
      elsif ($commande eq "C")  # Dump generated code
      {
        $Clean::sortie = '&STDOUT';
        $Clean::codedump = 1;
      }
      elsif ($commande eq "D")  # Debug mode
      {
        $Clean::sortie = '&STDOUT';
        $Clean::debugmode = 1;
      }
      elsif ($commande eq "V")  # Display version information
      {
        &message('INFO', "clean $Clean::version\n");
        exit 0;
      }      
      else                      # Unknown option
      {
        &message('WARNING', "Unknown option: ", $commande, "\n");
      }
    }
  }
}

####
##  Test wether a file is stripped or not
##  Input: absolute filename
##  Output: 1 if not stripped, else 0
####

sub is_not_stripped
{
  my($file) = shift;
  my($result);
    
  #    $file = quotemeta($file);

  # FIXME: Maybe I could add a hack for specific platforms (Linux/ELF,
  # Solaris 2.5) to process the /etc/magic file and avoid to call an
  # external program. This would save a lot of time.
  
  # Avoid problems with non standard names (is it sufficient ?)
  $file =~ s/'/\\'/g;

  chop ( $result = `@Clean::file_prg \'$file\'` );

  # Since the 4.41 rev., there was an extra-condition which tried to
  # correctly understand the output of broken /etc/magic files in some
  # linux distributions. It introduced in fact a bug, so it was
  # removed in 4.48. You should get a correct /etc/magic for your
  # linux distribution (from Debian 1.3 for instance), which displays
  # "not stripped".
  return ( ($result =~ /not stripped/i) ? 1 : 0 );
}

####
## Converts a number into a comma-separated number
## (From The Llama Book)
## Input: number
## Output: formatted number
####

sub commas
{
  local($_) = shift;

  1 while s/(.*\d)(\d\d\d)/$1,$2/;
  $_;
}

####
##  Verifies that the regexp is not in the forbidden regexps list
##  Input: the regexp to check
##  Output: none, it dies if the regexp is forbidden
####

sub check_regexp
{
  my($regexp) = shift;
  my $exp;
  
  # No / in regexps
  if ($regexp =~ /\//)
  {
    die "ERROR: the regexp ", $regexp, " contains a /.\nIt is not valid, since regexps do not apply through directories. Please correct it.\n";
  }
  for $exp ( @Clean::exclude_regexp )
  {
    if ($regexp eq $exp)
    {
      die "ERROR: A non-authorized regexp is in your config file (", $Clean::config_file, ")\nPlease correct it.\nThe regexp is (line $.): ", $regexp , "\n";
    }
  }
}

####
##  Splits the parameter string
##  Input: the parameter line
##  Output: a couple ($param1, $param2)
####

sub get_parameter
{
  my($param) = shift;
  my($param1, $param2);
  
  if ($param =~ /\s/)
  {
    # We ignore the third parameter anyway
    ($param1, $param2, undef) = split(/\s+/, $param, 3);
  }
  else
  {
    # No ageing parameter
    $param1 = $param;
    $param2 = "";
  }
  
  return ($param1, $param2);  
}

####
##  Get the regexp and date from a input line.
##  Input: the parameter line
##  Output: a couple (regexp, date)
####

sub get_regexp_date
{
  my($param) = shift;
  my($regexp, $date) = &get_parameter($param);

  $date = -1 if ($date !~ /^[\-+]?\d+$/);
  
  ($regexp, $date);
}

####
##  Read the config file
##  Input: config file to be read
##  Output: none
####

sub read_config_file
{
  my $conf = shift;

  # These arrays are all global variables
  @Clean::list_erase     = ();
  @Clean::list_erase_opt = ();
  @Clean::list_gzip      = ();
  @Clean::list_gzip_opt  = ();
  %Clean::protected_dir  = ();
  @Clean::list_dir_erase = ();
  @Clean::list_dir_empty = ();

  my($mode) = (stat($conf))[2];
  
  my($command);
  my($parameter);
  my($err) = 0;
  my(@list_protect) = ();
  my $line;
  my($regexp, $date);
  my($options) = "";
  my $dir;
  
  # Check the permissions of the config  file
  $mode = $mode & 0022;
  
  if ($mode != 0)
  {
    die "Warning! The configuration file (", $conf, ") is not write-protected.
Change the permissions, check the file and rerun the program\n";
  }
  
  open(RC, $conf) or die "Cannot read the config file $conf: $!\n";
  
  while (defined($line = <RC>))
  {
    chomp($line);
    
    next if ($line =~ /^\s*\#/ or $line =~ /^\s*$/);
    
    ($command, $parameter) = split(/=/, $line, 2);
    
    # Files to delete
    
    if ($command eq "DEL")
    {
      ($regexp, $date) = &get_regexp_date($parameter);
      
      &check_regexp($regexp);
  
      next if ($regexp eq "");
      
      push(@Clean::list_erase, [$regexp, $date]);
      next;
    }
    
    # Files to delete if the -a option is set
    
    if ($command eq "DELOPT")
    {
      ($regexp, $date) = &get_regexp_date($parameter);
      
      &check_regexp($regexp);
  
      next if ($regexp eq "");
      
      push(@Clean::list_erase_opt, [$regexp, $date]);
      next;
    }
    
    # Files to compress
    
    if ($command eq "ZIP")
    {
      ($regexp, $date) = &get_regexp_date($parameter);
      
      &check_regexp($regexp);

      next if ($regexp eq "");
      
      push(@Clean::list_gzip, [$regexp, $date]);
      next;
    }       
    
    # Files to compress if the -a option is set
    
    if ($command eq "ZIPOPT")
    {
      ($regexp, $date) = &get_regexp_date($parameter);
      
      &check_regexp($regexp);

      next if ($regexp eq "");
      
      push(@Clean::list_gzip_opt, [$regexp, $date]);
      next;
    }       
    
    # Directories to delete
    
    if ($command eq "DELDIR")
    {
      ($regexp, $date) = &get_regexp_date($parameter);
      
      &check_regexp($regexp);

      next if ($regexp eq "");
      
      push(@Clean::list_dir_erase, [$regexp, $date]);
      next;
    }

    # Compression program

    if ($command eq "ZIP_PRG")
    {
      @Clean::gzip_prg = split(/\s+/, $parameter);
      &message('DEBUG', "gzip changed to ", join(' ', @Clean::gzip_prg), "\n")
      if $Clean::debugmode;
      next;
    }
    
    # "file" program
    
    if ($command eq "FILE_PRG")
    {
      @Clean::file_prg = split(/\s+/, $parameter);
      &message('DEBUG', "file changed to ", join(' ', @Clean::file_prg), "\n")
      if $Clean::debugmode;
      next;
    }
    
    # "strip" program
    
    if ($command eq "STRIP_PRG")
    {
      @Clean::strip_prg = split(/\s+/, $parameter);
      &message('DEBUG',"strip changed to ", join(' ', @Clean::strip_prg), "\n")
      if $Clean::debugmode;
      next;
    }
    
    # Directories to empty
    
    if ($command eq "EMPTYDIR")
    {
      ($dir, $date) = &get_regexp_date($parameter);
      
      next if ($dir eq "");
      
      $dir =~ s!^\~/!$Clean::home/!;
      push(@Clean::list_dir_empty, [$dir, $date]);
      next;
    }

    # Protected directories
    
    if ($command eq "PROTECT")
    {
      if ($parameter !~ /^\s*$/)
      {
        $Clean::protect = 1;
        # Strip comments
        $parameter =~ s/\s+.*$//;
        $parameter =~ s!^\~/!$Clean::home/!;
        push(@Clean::list_protect, $parameter);
      }
      next;
    }

    if ($command eq "HISTORY_FILE")
    {
      if ($parameter !~ /^\s*$/)
      {
        # Strip comments
        $parameter =~ s/\s+.*$//;
        $parameter =~ s!^\~/!$Clean::home/!;
        $Clean::history_file = $parameter;
      }
      next;
    }

    if ($command eq "HIDE_MESSAGE")
    {
      my $level;
      
      ($level, $regexp) = &get_parameter($parameter);
      
      if (! defined ($Clean::hide_message{$level}))
      {
        &message ('WARNING', "The display level name $level is not defined. Please check your config file.");
        exit;
      }

      $regexp =~ s/^\s+//;
      $regexp =~ s/\s+$//;
      
      if ($regexp eq "")
      {
        # No parameter means that the message should always be hidden.
        push(@{$Clean::hide_message{$level}}, '.*');
      }
      else
      {
        push(@{$Clean::hide_message{$level}}, $regexp);
      }

      next;
    }

    # Options
    
    if ($command eq "OPTIONS")
    {
      # We delay the evaluation of the options as long as we are
      # reading the config file. Some people did not understood (and
      # were not expected to) the behaviour of the -a option if placed
      # before the *OPT options. Anyway, I forbid to use -a in the
      # config file options, so that's no more a problem.
      $options .= " " . $parameter;
      next;
    }

    # Minimum age of files to be stripped
    if ($command eq "STRIP_AGE")
    {
      $Clean::strip_age = $parameter;
      next;
    }
    
    # If we're here, we have an unknown command
    
    $err++;
    
    if ($err > $Clean::max_errors)
    {
      die <<"EOF";
      
      Too many errors in config file.
      Config files created by clean 2.93 or less are obsolete.
      Please delete your config file and rerun clean,
      it will create a new standard config file.
EOF
    }

    &message('WARNING', "Unknown command in .cleanrc : >", $line, "<\nPress ENTER to go on.\n");
    <STDIN>;
  }
  
  close(RC);

  # Delayed option parsing : here we go...
  # The 1 (2nd parameter) is here to say that we are reading a
  # config file, so the -m option is invalid
  &parse_options([split(' ', $options)], 1);

  # Transform the @list_protect list into %protected_dir
  %Clean::protected_dir = map( ($_ => 1), @Clean::list_protect);
  undef @Clean::list_protect;
}

####
##  Returns the state of the variable
##  Input: the variable
##  Output: "on" or "off"
####

sub state
{
  return ($_[0] == 0 ? 'off' : 'on');
}

####
##  Display the contents of erase and zip lists
##  Input: the list to display
##  Output: none
####

sub display_list
{
  my(@list_tmp) = @{$_[0]};
  my $ref;
  # local instead of my here because of the format. Cf the perlsub
  # manpage for details.
  local($::exp, $::date, $::exp2, $::date2);

  format LOPTIONS =
 @<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<< |  @<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<
$::exp,$::date,$::exp2,$::date2
.
  
  $~ = LOPTIONS;
  
  if ($#list_tmp < 0)
  {
    &message('STD', "None.\n");
  }

  while ($#list_tmp >= 0)
  {
    $ref = shift(@list_tmp);

    $::exp  = $ref->[0];
    $::date = $ref->[1];
    
    $::date = $::date <= 0 ? "" : "(> " . $::date . " days)";

    # More comprehensible display form for people who do not grok regexps
    $::exp =~ s/\.\+/*/g;
    $::exp =~ s/\\\././g;
    
    if ($#list_tmp>=0)
    {
      $ref = shift(@list_tmp);
      
      $::exp2  = $ref->[0];
      $::date2 = $ref->[1];
      
      $::date2 = $::date2 <= 0 ? "" : "(> " . $::date2 . " days)";
      
      $::exp2 =~ s/\.\+/*/g;
      $::exp2 =~ s/\\\././g;
      
    }
    else
    {
      $::date2 = '';
      $::exp2  = '';
    }
    write ;
  }
}

####
## Print the options
## Input: none
## Output: none (exits)
####

sub print_options
{
  $Clean::home = (getpwuid($<))[7] || die "You don\'t seem to be registered in the passwd file...\n";
  $Clean::sortie =~ s!^$Clean::home/!\~/!;
  $Clean::config_file =~ s!^$Clean::home/!\~/!;
  
  format POPTIONS=
                     @|||||||||||||||
$Clean::nom_prg

State of options : @*
$Clean::norm
  Config. file     : @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Clean::config_file
  Output to        : @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Clean::sortie

    Interactive      : @<<<<   (-i) |  Checking only    : @<<<<   (-c)
&state($Clean::interactive), &state($Clean::verify)
    Dir. recursion   : @<<<<  (!-n) |  Report           : @<<<<   (-r)
&state($Clean::recurse), &state($Clean::report)
    Stripping        : @<<<<   (-x) |  Links following  : @<<<<   (-l)
&state($Clean::stripping), &state($Clean::followlinks)
    Del. inv. links  : @<<<<   (-z) |  Del. empty dirs  : @<<<<   (-e)
&state($Clean::delete_links), &state($Clean::del_empty_dir)
    Dir. protection  : @<<<<  (!-u) |  Perm. checking   : @<<<<   (-w)
&state($Clean::protect), &state($Clean::write_check)
    "all" option     : @<<<<   (-a) |  Nice level       : @<<<<   (-g)
&state($Clean::all_option), $Clean::gentle
    Dir. emptying    : @<<<<   (-j) |  Zip limit size   : @<<<<<
&state($Clean::empty_junk_dir),$Clean::gzip_limit_size

.

  &message('INFO', $Clean::bold);
  $~ = POPTIONS;
  write;
  
  &message('INFO',  <<"EOF");
  Zip program      : @Clean::gzip_prg
  File program     : @Clean::file_prg
  Strip program    : @Clean::strip_prg

EOF

  &message('INFO', "  Strip files if age > $Clean::strip_age\n\n")
  if ($Clean::strip_age > 0);
  
  &message('INFO',  $Clean::bold, "Files to erase :", $Clean::norm, "\n");
  
  &display_list(\@Clean::list_erase);
  
  &message('INFO', "\n", $Clean::bold, "Files to gzip :", $Clean::norm, "\n");
  
  &display_list(\@Clean::list_gzip);
  
  &message('INFO', "\n", $Clean::bold, "Directories to erase :",
           $Clean::norm, "\n");
  
  &display_list(\@Clean::list_dir_erase);
  
  &message('INFO', "\n", $Clean::bold, "Directories to empty (if -j is set):",
           $Clean::norm, "\n");

  if (scalar(@Clean::list_dir_empty) == 0)
  {
    &message('INFO', "None.\n");
  }
  else
  {
    my($item);
    for $item (@Clean::list_dir_empty)
    {
      &message('INFO', $item->[0]);
      if ($item->[1] > 0)
      {
        &message('INFO', "(" . $item->[1] . " days)");
      }
      &message('INFO', "\n");
    }
  }

  &message('INFO', "\n", $Clean::bold, "Protected directories:",
           $Clean::norm, "\n");
  
  if (scalar(keys %Clean::protected_dir) == 0)
  {
    &message('INFO', "None.\n");
  }
  else
  {
    for ( keys %Clean::protected_dir )
    {
      &message('INFO', $_, "\n");
    }
  }

  &message('INFO', "\n", $Clean::bold, "Display levels: ",
           $Clean::norm, join(", ", keys(%Clean::display)), "\n");

#  &message('INFO', "\n", $Clean::bold, "Display levels: ",
#           $Clean::norm, join(", ", keys(%Clean::display)), "\n");

  &message('INFO', "\n");
  exit(0);
}

####
##  Does the deletion of a file
##  Input: a couple (absolute filename, abbreviated filename)
##  Output: size of the deleted file (0 if the file could not be deleted)
####

sub do_delete
{
  my($file)     = shift;
  my($filename) = shift;
  my($result)   = 0;
  my $answer;
  
  if ($Clean::verify == 1)             # Only checking
  {
    &message('STD', "Removing ", $filename, "...todo\n");
    -s $file;
  }
  elsif ($Clean::interactive == 1)     # Asks for a confirmation
  {
    &message('INTER', "Removing ", $filename, "... (y/n/q) ?");
    chop($answer = <STDIN>);
    
    if ($answer =~ /^q/i)
    {
      &message('STD', "OK. Exiting,\n");
      exit(0);
    }
    elsif ( $answer =~ /^y/i )
    {
      &message('STD', "Removing ", $filename, "...");
      
      $result = -s $file;
      
      if (unlink($file) == 1)
      {
        &message('STD', "ok\n");
        $result;
      }
      else
      {
        &message('STD', "cannot: $!\n");
        0;
      }
    }
  }
  else                          # Remove the file
  {
    &message('STD', 'Removing ', $filename, '...');
   
    $result = -s $file;
   
    if (unlink($file) == 1)
    {
      &message('STD', "ok\n");
      $result;
    }
    else
    {
      &message('STD',  "cannot: $!\n");
      0;
    }
  }
}


####
##  Does the compression of a file
##  Input: a couple (absolute filename, abbreviated filename)
##  Output: gained size (0 if the file could not be compressed)
####

sub do_compress
{
  my($file) = shift;
  my($filename) = shift;
  my($result) = 0;
  my $answer;
  my $return_code;
  
  if ($Clean::verify == 1)             # Only checking
  {
    &message('STD', "Zipping ", $filename, "...todo\n");
    0;
  }
  elsif ($Clean::interactive == 1)     # Asks for a confirmation
  {
    &message('INTER', "Zipping ", $filename, "... (y/n/q) ?");
    chop($answer = <STDIN>);
    
    if ($answer =~ /^q/i)
    {
      &message('STD', "OK. Exiting.\n");
      exit(0);
    }
    elsif ( $answer =~ /^y/i )
    {
      &message('STD', "Zipping ", $filename, "...");
      
      $result = -s $file;
      
      $return_code = system(@Clean::gzip_prg, $file);
      
      if ($return_code == 0)
      {
        &message('STD', "ok\n");
        $file .= ".gz";
        $result - (-s $file);
      }
      else
      {
        &message('STD', "cannot\n");
        0;
      }
    }
  }
  else                  # Remove the file
  {
    &message('STD', "Zipping ", $filename, "...");
   
    $result = -s $file;
   
    $return_code = system(@Clean::gzip_prg, $file);
   
    if ($return_code == 0)
    {
      &message('STD', "ok\n");
      $file .= ".gz";
      $result - (-s $file);
    }
    else
    {
      &message('STD', "cannot\n");
      0;
    }
  }
}

####
##  Deletes invalid links
##  Input: a couple (absolute filename, abbreviated filename)
##  Output: size of the deleted link (0 if the file could not be deleted)
####

sub do_delete_links
{
  my($file) = shift;
  my($filename) = shift;
  my $answer;
  my $result;
  
  if ($Clean::verify == 1)             # Only checking
  {
    &message('STD', "Removing ", $filename, " (invalid link)...todo\n");
    0;
  }
  elsif ($Clean::interactive == 1)     # Asks for a confirmation
  {
    &message('INTER', "Removing ", $filename, " (invalid link)...(y/n/q) ?");
    chop($answer = <STDIN>);
    
    if ($answer =~ /^q/i)
    {
      &message('STD', "OK. Exiting.\n");
      exit(0);
    }
    elsif ( $answer =~ /^y/i )
    {
      &message('STD', "Removing ", $filename, " (invalid link)...");
      
      $result = -s $file;
      
      if (unlink($file) == 1)
      {
        &message('STD', "ok\n");
        $result;
      }
      else
      {
        &message('STD', "cannot: $!\n");
        0;
      }
    }
  }
  else
  {
    &message('STD', "Removing ", $filename, " (invalid link)...");
    $result = -s $file;
   
    if (unlink($file) == 1)
    {
      &message('STD', "ok\n");
      $result;
    }
    else
    {
      &message('STD', "cannot: $!\n");
      0;
    }
  }
}

####
##  Strips a file
##  Input: a couple (absolute filename, abbreviated filename)
##  Output: gained size (0 if the file could not be stripped)
####

sub do_strip
{
  my($file) = shift;
  my($filename) = shift;
  my($result) = 0;
  my $answer;
  my $return_code;
  
  if ($Clean::verify == 1)             # Only checking
  {
    &message('STD', "Stripping ", $filename, "...todo\n");
    0;
  }
  elsif ($Clean::interactive == 1)     # Asks for a confirmation
  {
    &message('INTER', "Stripping ", $filename, "... (y/n/q) ?");
    chop($answer = <STDIN>);
    
    if ($answer =~ /^q/i)
    {
      &message('STD', "OK. Exiting.\n");
      exit(0);
    }
    elsif ( $answer =~ /^y/i )
    {
      &message('STD', "Stripping ", $filename, "...");
      
      $result = -s $file;
      
      $return_code = system(@Clean::strip_prg, $file);
      
      if ($return_code == 0)
      {
        &message('STD', "ok\n");
        $result - (-s $file);
      }
      else
      {
        &message('STD', "cannot\n");
        0;
      }
    }
  }
  else                  # Strip the file
  {
    &message('STD', "Stripping ", $filename, "...");
        
    $result = -s $file;
        
    $return_code = system(@Clean::strip_prg, $file);
        
    if ($return_code == 0)
    {
      &message('STD', "ok\n");
      $result - (-s $file);
    }
    else
    {
      &message('STD', "cannot\n");
      0;
    }
  }
}


####
##  Deletes empty dir
##  Input: a couple (absolute dirname, abbreviated dirname)
##  Output: size of the deleted dir (0 if the dir could not be deleted)
####

sub do_delete_empty_dir
{
  my($file)     = shift;
  my($filename) = shift;
  my $answer;
  my $result;
  
  if ($Clean::verify == 1)             # Only checking
  {
    &message('STD', "Removing ", $filename, "/ (empty dir)...todo\n");
    return 0;
  }
  elsif ($Clean::interactive == 1)     # Asks for a confirmation
  {
    &message('INTER', "Removing ", $filename, "/ (empty dir)...(y/n/q) ?");
    chop($answer = <STDIN>);
    
    if ($answer =~ /^q/i)
    {
      &message('STD', "OK. Exiting.\n");
      exit(0);
    }
    elsif ( $answer =~ /^y/i )
    {
      &message('STD', "Removing ", $filename, "/ (empty dir)...");
      
      $result = -s $file;
      
      if (rmdir($file) == 1)
      {
        &message('STD', "ok\n");
        $result;
      }
      else
      {
        &message('STD', "cannot: $!\n");
        return 0;
      }
    }
  }
  else                          # Remove the file
  {
    my $r;

    &message('STD', "Removing ", $filename, "/ (empty dir)...");

    $result = -s $file;

    $r = rmdir($file);
    if ($r == 1)
    {
      &message('STD', "ok\n");
      $result;
    }
    else
    {
      &message('STD', "cannot: $!\n");
      0;
    }
  }
}


####
##  Deletes full dir.
##  Input: a couple (absolute dirname, abbreviated dirname)
##  Output: size of the deleted dir (0 if the dir could not be deleted)
####
sub do_delete_dir
{
  my($file)     = shift;
  my($filename) = shift;
  my $answer;
  my $result;
  
  if ($Clean::verify == 1)             # Only checking
  {
    &message('STD', "Removing ", $filename, "/...todo\n");
    0;
  }
  elsif ($Clean::interactive == 1)     # Asks for a confirmation
  {
    &message('INTER', "Removing ", $filename, "/...(y/n/q) ?");
    chop($answer = <STDIN>);
    
    if ($answer =~ /^q/i)
    {
      &message('STD', "OK. Exiting.\n");
      exit(0);
    }
    elsif ( $answer =~ /^y/i )
    {
      $result = &recursive_delete($file, $filename);
      $result;
    }
  }
  else                  # Remove the file
  {
    $result = &recursive_delete($file, $filename);
    $result;
  }
}

####
## Recursively deletes each file in the directory
##  Input: a couple (absolute dirname, abbreviated dirname)
##  Output: size of the deleted files (0 if no file could be deleted)
####
sub recursive_delete
{
  my($dir, $dirname) = @_;
  my($taille)        = 0;
  
  if (! -d $dir)
  {
    &message('WARNING', "$dirname ($dir) is no directory\n");
    return 0;
  }
  
  $taille += &do_delete_files_in_dir($dir, $dirname);

  $taille += &do_delete_empty_dir($dir, $dirname);

  $taille;
}
  
####
## Recursively deletes all the files in dir, but does not try to delete the
## directory itself
##  Input: a triplet (absolute dirname, abbreviated dirname, facultative age
##         that the files must be to be deleted)
##  Output: size of the deleted files (0 if no file could be deleted)
####
sub do_delete_files_in_dir
{
  my($dir, $dirname, $date) = @_;
  my($taille) = 0;
  my(@files)  = ();
  my($file)   = "";
  my(@stat)   = ();
  my $f;
  my($filename);
  
  $date = 0 if (! defined $date);
  if (! -d $dir)
  {
    &message('WARNING', "$dirname is no directory\n");
    return 0;
  }

  if (! opendir(D, $dir))  
  {
    &message('WARNING', "Cannot open $dir: $!\n");
    return 0;
  }

  @files = grep($_ ne '.' && $_ ne '..', readdir(D));
  close(D);
  
  for $f (@files)
  {
    $file = $dir . "/" . $f;
    $filename = $dirname . "/" . $f;

    &message('DEBUG', "Processing ", $filename, " (", $file, ")\n")
    if $Clean::debugmode;

    @stat = stat($file);
    
    # We only delete files owned by the user (should maybe be an option)
    if ($stat[4] == $Clean::uid)
    {
      $Clean::total_size += $stat[7];

      if ($date > 0 and -M $file < $date)
      {
        &message('DEBUG', $filename, " is too recent.\n") if $Clean::debugmode;
        next;
      }
      
      if (-l $file)
      {
        $taille += &do_delete($file, $filename);
      }
      else
      {
        if (-d _)
        {
          $taille += &recursive_delete($file, $filename);
        }
        else
        {
          $taille += &do_delete($file, $filename);
        }
      }
    }
  }

  $taille;
}

####
##  Empties appropriate directories
##  Input: none
##  Output: none
####
sub do_empty_dirs
{
  my($dir);
  my $dirname;
  my $ref;
  my $date;

  for $ref (@Clean::list_dir_empty)
  {
    $dir = $ref->[0];
    $date = $ref->[1];
    $dirname = $dir;
    $dirname =~ s!^$Clean::home/!\~/!o;
    
    $Clean::delete_size += &do_delete_files_in_dir($dir, $dirname, $date)
    if (-e $dir && -d _);
  }
}

####
##  Builds the code for the tests only
##  Input: A reference to the list of couples (regexp, date)
##         A string to be executed if report == 1
##         A string to be executed if report == 0
##  Output: Generated code.
####    

sub build_test
{
  my($listref) = shift;
  my($report_line) = shift;
  my($no_report_line) = shift;
  my(@list_tmp) = @$listref;
  my $result = "";
  my($exp, $date);
  my $ref;

  return "" if (scalar(@list_tmp) == 0);
  
  $result .= "      if ";
  
  while (scalar(@list_tmp) > 0)
  {
    $ref = shift(@list_tmp);
    $exp  = $ref->[0];
    $date = $ref->[1];
    
    $result .= "((\$nom =~ /^$exp\$/o)";
    
    if ($date > 0)
    {
      $result .= " && ((-M _) > $date)";
    }
    
    $result .= ")\n";
    
    if ($Clean::report == 1)
    {
      $result .= <<"FIN_DU_CODE";
      {
        $report_line
        next;
      }
FIN_DU_CODE
    }
    else
    {
      $result .=<<"FIN_DU_CODE";
                {
                    $no_report_line
                    next;
                }
FIN_DU_CODE
    }
    
    if (scalar(@list_tmp) > 0)
    {
      $result .= "      elsif ";
    }
    else
    { 
      $result .= "\n\n"; 
    }
    
  }           # End of while (scalar(@list_tmp)>0) (for list_dir_erase)

  return $result;
}

####
## Builds the code for the test procedure.
## Really unreadable :-( but I still manage to understand it ;-)
## Input: none
## Output: generated code
####

sub construction
{
  my $code = "";
  my $tmpcode;

  # Not nice to read, but is definitely faster this way.
  # To print the generated code, run 'clean <options> -C'
  # It will print the code, then exit

  $code =<<"FIN_DU_CODE";
####
## Cleans the specified directory.
## Note: This code is generated.
##  Input: the directory to process (absolute dirname)
##  Output: none
####

sub process_dir
{
  my(\$dir) = shift;
  my(\$dirname) = \$dir;
  my(\@content);
  my(\$rep);
  my(\$nom, \$file, \$filename);
  my(\@stat);

  \$dirname =~ s!^$Clean::home(/|\$)!\~\$1!;

FIN_DU_CODE

  if ($Clean::write_check == 1)
  {
    $code .=<<"FIN_DU_CODE";
  \@stat = stat(\$dir);
    
  if ((\$stat[2] & $Clean::write_umask) != 0)
  {
    &message('SECURITY', \$dirname, " is writable by others\\n");
  }
  if (\$stat[7] == 0)
  {
    &message('WARNING', \$dirname, " is empty.\\n");
  }
FIN_DU_CODE
  }

  if ($Clean::protect == 1)
  {
    
    $code .= <<"FIN_DU_CODE";
    
  # Test if the directory is protected
  if (defined \$Clean::protected_dir{\$dir})
  {
    &message('WARNING', \$dirname, " is protected\\n");
    return 0;
  }

FIN_DU_CODE

  }     # End of if ($protect == 1)

  $code .= <<"FIN_DU_CODE";
  if (! chdir(\$dir))
  {
    &message('WARNING', "Unable to chdir to \$dir: \$!\\n");
    return 0;
  }
  if (! opendir(D, "."))
  {
    &message('WARNING', "Unable to read dir \$dir: \$!.\\n");
    return 0;
  }
  \@content = sort(grep(\$_ ne '.' && \$_ ne '..', readdir(D)));
  closedir(D);

FIN_DU_CODE

  if ($Clean::del_empty_dir == 1)
  {
    
    $code .= <<"FIN_DU_CODE";

  if (scalar(\@content) == 0)
  {
    if (! chdir('..'))
    {
      &message('WARNING', "Unable to chdir to .. from \$dir: \$!\\n");
      return 0;
    }
    \$Clean::delete_size += &do_delete_empty_dir(\$dir, \$dirname);
    return 0;
  }
FIN_DU_CODE

  }  # End of if ($del_empty_dir == 1)

  $code .= <<"FIN_DU_CODE";
  for \$nom (\@content)
  {
    \$file = \$nom;
    \$filename = \$dirname eq '/' ? '/'.\$nom : join('/', \$dirname, \$nom);
    
    stat(\$file);

FIN_DU_CODE


  if ($Clean::debugmode == 1)
  {
    $code .=<<"FIN_DU_CODE";
    &message('DEBUG', "Processing ", \$filename, " (", \$file, ")\\n");
FIN_DU_CODE
  }


  $code .=<<"FIN_DU_CODE";
    if (-d _)
    {
FIN_DU_CODE

  $code .= &build_test(\@Clean::list_dir_erase,
                       '$Clean::delete_size += &do_delete_dir($file, $filename);',
                       '&do_delete_dir($file, $filename);');

  if ($Clean::recurse == 1)
  {
    $code .= <<"FIN_DU_CODE";
      if (-l \$file)
      {
        # symbolic link
FIN_DU_CODE

    if ($Clean::followlinks == 1)
    {

      $code .= <<"FIN_DU_CODE";
        &process_dir(readlink(\$file));
        chdir(\$dir);
FIN_DU_CODE

    }
    else                                # From if ($followlinks==1)
    {
     $code .= <<"FIN_DU_CODE";
        &message('WARNING', \$filename, " is a symbolic link\\n");
FIN_DU_CODE

    }                           # End of if ($followlinks==1)

    $code .=<<"FIN_DU_CODE";
      }
      else
      {
FIN_DU_CODE

    if ($Clean::report == 1)
    {
      $code .= <<"FIN_DU_CODE";
        \$Clean::total_size += -s _;
FIN_DU_CODE
    }

    $code .=<<"FIN_DU_CODE";
        &process_dir(\$dir eq '/' ? '/'.\$file : join('/', \$dir, \$file));
        chdir(\$dir);
      }
FIN_DU_CODE

  }                            # End of if ($recurse==1)

  $code .= <<"FIN_DU_CODE";
    }
    elsif ((-f _) && !(-l \$file))
    {
      \@stat = stat(\$file);

FIN_DU_CODE

  if ($Clean::report == 1)
  {
    $code .= <<"FIN_DU_CODE";
      \$Clean::total_size += -s _;
FIN_DU_CODE
  }

  if ($Clean::write_check == 1)
  {
    $code .=<<"FIN_DU_CODE";
      if ((\$stat[2] & $Clean::write_umask) != 0)
      {
        &message('SECURITY', \$filename, " is writable by others\\n");
      }
      if (\$stat[7] == 0)
      {
        &message('WARNING', \$filename, " is empty.\\n");
      }
FIN_DU_CODE
  }

  $code .=<<"FIN_DU_CODE";
      study(\$nom);
FIN_DU_CODE

  $code .= &build_test(\@Clean::list_erase,
                       '$Clean::delete_size += &do_delete($file, $filename);',
                       '&do_delete($file, $filename);');

  $code .= <<FIN_DU_CODE;

      # zipping files...

FIN_DU_CODE

  $code .= &build_test(\@Clean::list_gzip,
                       '$Clean::zip_size += &do_compress($file, $filename);',
                       '&do_compress($file, $filename);');

  if ($Clean::stripping == 1)
  {
    if ($Clean::strip_age > 0)
    {
      $tmpcode = "((-M _) > $Clean::strip_age)\n       && ";
    }
    else
    {
      $tmpcode = "";
    }
    
    $code .= <<"FIN_DU_CODE";
      # Stripping executable files (but not libraries)...

      if ($tmpcode (\$file !~ /\\.so(\\.\\d+)*\$/)     # Not a dynamic lib
	  && (-x \$file)                      # Executable
	  && (&is_not_stripped(\$file) == 1)) # Not stripped
      {
FIN_DU_CODE
    
    if ($Clean::report == 1)
    {
      $code .= <<"FIN_DU_CODE";
        \$Clean::strip_size += &do_strip(\$file, \$filename);
      }
FIN_DU_CODE
    }
    else
    {
      $code .= <<"FIN_DU_CODE";
        &do_strip(\$file, \$filename);
      }
FIN_DU_CODE
    }
  }       # End of if ($stripping == 1)

  if ($Clean::delete_links == 1)
  {

    $code .= <<"FIN_DU_CODE";
    }
    elsif (-l \$file)
    {
      if (! -e \$file)
      {
        &do_delete_links(\$file, \$filename);
      }

FIN_DU_CODE
;
  }
 
  $code .= <<"FIN_DU_CODE";
    } # End of elsif (-f _) or elsif (-l \$file)

  }   # End of for ()

  undef \@content;
}

1;
FIN_DU_CODE

}

####
## Main routine
## Input: the processed directory
## Output: none
####

sub main
{
  my($dir);
  my $code;
  
  $code = &construction;
  
  if ($Clean::codedump == 1)
  {
    &message('DEBUG', $code);
    exit(0);
  }
  
  if ($Clean::sortie ne "&STDOUT")
  {
    # Note : we have to use the . operator, so that localtime is
    # executed in a scalar context
    &message('INFO', 'clean was run on ' . localtime(time) . "\n");
    $Clean::bold = '';
    $Clean::norm = '';
  }
  
  if ($Clean::sortie ne '&STDOUT' && $Clean::interactive == 1)
  {
    $Clean::sortie = '&STDOUT';
    &message('INFO', "The interactive option is on. Output must be on stdout.\n");
  }

  # We evaluate $code to define the process_dir function
  eval($code);
  die $@ if $@;

  for $dir ( @Clean::dir )
  {
    if ($Clean::verify == 1)
    {
      &message('INFO', "Checking directory : $dir \n\n");
    }
    else
    {
      &message('INFO', "Cleaning directory : $dir \n\n");
    }
    
    stat($dir);

    if ( ! (-d _) )
    {
      &message('ERROR', $dir, " does not exist or is not a directory.\n");
      exit(1);
    }
    
    &Clean::process_dir($dir);

  }
  
  # Now let's empty some dirs if necessary
  &do_empty_dirs if ($Clean::empty_junk_dir == 1);

  &message('STD', "\n");

  &display_report if ($Clean::report == 1);

  exit(0);
}

####
## Processes the todo file
## Input: none
## Output: none
####

sub process_todo_file
{
  my $answer;
  my(@files);
  my(@erase);
  my(@compress);
  my(@strip);
  my $line;
  my($file, $filename);
  
  $Clean::verify = 0;

  if ($Clean::sortie eq '&STDOUT' or $Clean::sortie eq '/dev/null')
  {
    &message('ERROR', "You must specify a todo file with the -f option.\n");
    exit(0);
  }
  
  if (! -r $Clean::sortie)
  {
    &message('ERROR', "The file ", $Clean::sortie, " does not exist.\n");
    exit(0);
  }
  
  if ( -M $Clean::sortie > 1 )
  {
    &message('INTER', 'The todo file is older than 1 day. Process it anyway (y/n) ? ');
    
    chop($answer = <STDIN>);
    if ($answer !~ /^y/i)
    {
      &message('INTER', "Aborting. Run\n     clean -cf\nto generate a todo file.\n");
      exit(0);
    }
  }

  &message('STD', 'Processing the todo file ', $Clean::sortie, "\n\n");
  
  open(TODO, $Clean::sortie) or die "Unable to open $Clean::sortie: $!\n";
  
  @files = <TODO>;
  
  @erase = grep(/^Removing.+todo$/, @files);
  @compress = grep(/^Zipping.+todo$/, @files);
  @strip = grep(/^Stripping.+todo$/, @files);
        
  close(TODO);

  $Clean::sortiefh = new FileHandle ">-";
  
  die "Unable to open STDOUT: $!\n" if (! defined $Clean::sortiefh);

  &message('STD', $Clean::bold, "Files to delete:", $Clean::norm, "\n");
  
  if (scalar(@erase) == 0)
  {
    &message('STD', "No file to delete\n");
  }
  else
  {
    for $line (@erase)
    {
      ($filename) = ($line =~ /^Removing\s+(.+?)(\s\((invalid link|empty dir)\)\s*)?\.\.\.todo$/);
      $file = $filename;
      $file =~ s!^\~/!$Clean::home/!;
      
      if ($file !~ m!\/$!)
      {
        $Clean::delete_size += &do_delete($file, $filename);
      }
      else
      {
        $file =~ s!\/$!!;
        $Clean::delete_size += &do_delete_dir($file, $filename);
      }
    }
  }

  &message('STD', "\n", $Clean::bold, "Files to compress:", $Clean::norm, "\n");
  
  if (scalar(@compress) == 0)
  {
    &message('STD', "No file to compress\n");
  }
  else
  {
    for $line (@compress)
    {
      
      ($filename) = ($line =~ /^Zipping (.+)\.\.\.todo$/);
      $file       = $filename;
      $file       =~ s!^\~/!$Clean::home/!;
      
      $Clean::zip_size += &do_compress($file, $filename);
    }
  }
  
  &message('STD', "\n", $Clean::bold, 'Files to strip:', $Clean::norm, "\n");
  if (scalar(@strip) == 0)
  {
    &message('STD', "No file to strip\n");
  }
  else
  {
    for $line (@strip)
    {
      
      ($filename) = ($line =~ /^Stripping (.+)\.\.\.todo$/);
      $file       = $filename;
      $file       =~ s!^\~/!$Clean::home/!;
      
      $Clean::strip_size += &do_strip($file, $filename);
    }
  }
  
  &message('INFO', $Clean::bold,"\n\tFile size report :", $Clean::norm, "\n\n");
  &message('INFO', "Size of deleted files         : ",
           &commas($Clean::delete_size), "\n");
  &message('INFO', "Size saved by zipping files   : ",
           &commas($Clean::zip_size), "\n");
  &message('INFO', "Size saved by stripping files : ",
           &commas($Clean::strip_size), "\n");
  &message('INFO', "\n");
  
  exit(0);
}

####
## Displays the report
## Input: none
## Output: none
#### 

sub display_report
{
  &message('INFO', $Clean::bold,"\tFile size report :", $Clean::norm, "\n\n");
  &message('INFO', "Old total size                : ",
           &commas($Clean::total_size), "\n");
  &message('INFO', "Size of deleted files         : ",
           &commas($Clean::delete_size), "\n");
  
  if ($Clean::verify == 0)
  {
    &message('INFO', "Size saved by zipping files   : ",
             &commas($Clean::zip_size), "\n");
    
    &message('INFO', "Size saved by stripping files : ",
             &commas($Clean::strip_size), "\n") if ($Clean::stripping == 1);
    
  }

  &message('INFO', "New total size                : ", $Clean::bold,
           &commas($Clean::total_size - $Clean::delete_size -
                   $Clean::zip_size - $Clean::strip_size),
           $Clean::norm, "\n");
  
  &message('INFO', "\n");
}

####
## Usage
## Input: none
## Output: none
####

sub help
{
  my($long_help) = shift;
  
  # We get the basename of the program
  $Clean::nom_prg =~ s/^(.+)\s.*/$1/;

  format STDOUT=
                 @|||||||||||||||   @*
$Clean::nom_prg,$Clean::norm
+----------------------------------------------------+
| version @<<<<<< : clean dir tree from undesirated  |
$Clean::version
+----------------------------------------------------+
|Syntax:                                             |
|       @||||||||||| [options] [directory]           |
$Clean::nom_prg
|                                                    |
|Short Options (use --help to get the long ones)     |
| -a deletes even optionally deleted files           | 
| -c check only           | -d default options       |
| -e del. empty dirs      | -h display help          |
| -l follows sym. links   | -mmode use .cleanrc-mode |
| -n no dir. recursion    | -o prints options & exits|
| -p process todo file    | -r display the report    |
| -s runs in silent mode  | -u unprotects prot.dirs. |
| -v output to stdout     | -w checks file perms     |
| -g[#] sets nice level to # (def.: 10)              |
| -x strips non-stripped executables                 |
| -z deletes invalid symlinks                        |
| -i asks wether to delete each file (interactive)   |
| -j Empties junk dirs (spec. by EMPTYDIR)           |
| -f[fname]  saves a report of deleted files         |
|            in fname (def. : $HOME/.clean-history)  |
|                                                    |
| Long name options are accepted.                    |
| To get the man page, use 'perldoc clean'.          |
|                                                    |
| by OA94    Send bug reports and suggestions to     |
|            @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<     |
'Olivier.Aubert@enst-bretagne.fr'
+----------------------------------------------------+
.

  if ($long_help)
  {
    print <<EOF
                 $Clean::nom_prg $Clean::version
         clean dir tree from undesirated

Syntax:
     $Clean::nom_prg [options] [directory]

Long options (use "$Clean::nom_prg -h" to get the short ones):
--all                   : deletes even optionally deleted files.
--check-only            : check only, no actions are executed.
--default               : default options.
--delete-empty-dir      : delete empty directories.
--output[=filename]     : saves a report of deleted files into
                          filename (default: \$HOME/.clean-history).
--gentle[=#]            : sets nice level to # (def.: 10).
--help                  : display help.
--interactive           : asks wether to delete each file.
--empty-junk-dir        : empties junk dirs (spec. by EMPTYDIR).
--follow-symbolic-links : follow symbolic links.
--mode=modename         : use .cleanrc-mode
--no-recursion          : no directory recursion.
--options               : prints options and exits.
--process-todo-file     : processes todo file.
--generate-report       : displays a report.
--silent, --quiet       : runs in silent mode.
--unprotect             : temporarily unprotects protected dirs.
--standard-output       : output to stdout.
--with-warnings         : check file permissions.
--strip-executables     : strips non-stripped executables.
--zap-invalid-links     : deletes invalid symlinks.
--code-dump             : dumps generated code (debug option).
--debug                 : displays debug messages.x
--version               : displays current version.

To get the man page, use 'perldoc clean'.

by OA94    Send bug reports and suggestions to
                Olivier.Aubert\@enst-bretagne.fr

EOF
  ;
  }
  else
  {
    &message('INFO', $Clean::bold);
    $~ = STDOUT;
    write ;
  }
  exit(0);
}
  
####
## SIG handler -- should maybe do some more cleaning
## Input: Signal name
## Output: none
####

sub handler
{
  # 1st argument is signal name
  my($sig) = $_[0];
  
  &message('ERROR', "Caught a SIG", $sig, " -- Goodbye\n");
  exit(0);
}

END
{
  $Clean::sortiefh->close if (defined $Clean::sortiefh);
}
  
####
## The script starts here
####

BEGIN
{
  # We first define $Clean::sortiefh for some routines depend on it.
  # It will change during the execution, when the $Clean::sortie value
  # is known.
  $Clean::sortiefh = new FileHandle '>-';
  die "Cannot open stdout for output: $!\n" if (! defined $Clean::sortiefh);
  $Clean::sortiefh->autoflush;
}

$Clean::nom_prg  = "clean";
$Clean::nom_prg .= " " . $Clean::version;
$0        = $Clean::nom_prg;

$SIG{'INT'}  = \&Clean::handler;
$SIG{'QUIT'} = \&Clean::handler;

# Get current directory
chomp($Clean::pwd = `/bin/pwd`);

&set_default_options;
  
$Clean::home = (getpwuid($<))[7]
|| die "You don\'t seem to be registered in the passwd file...\n";
$Clean::uid = $<;

$Clean::config_file = $ENV{'CLEANRC'} || $Clean::home . '/.cleanrc';

if (! -e $Clean::config_file)
{
  my $answer;
  
  &message('INTER', $Clean::config_file, " doesn't exist!\nIf you wish, the script will create a standard one,\ndisplay the options and then stop.\nDo you want to create a standard config file (y/n) ? ");
  chomp($answer = <STDIN>);
  if ( $answer =~ /^y/i )
  {
    &create_config_file($Clean::config_file);
    
    # This will force the script to display the options and stop.
    # Not really nice, but efficient, except if we specify the -V option
    # before...
    push(@ARGV, "-o");
  }
  else
  {
    die "Too bad...\nSee You Soon\n";
  }
}

&read_config_file($Clean::config_file);

&parse_options([@ARGV]);

# If no directory is specified, we assume it's the current one.
if (scalar(@Clean::dir) == 0)
{
  push(@Clean::dir, $Clean::pwd);
}

&check_progs;

&print_options if ($Clean::print_options == 1);

# We update the display routines now, according to the content of
# %Clean::hide_message
# We did not do it before for we wanted to be sure that warnings in parsing
# would always be displayed
&update_display_routines;

# If we want to process the todo file, we will open it for input
if ($Clean::process_todo_file == 0)
{
  $Clean::sortiefh = new FileHandle ">$Clean::sortie";
  die "Cannot open $Clean::sortie for output: $!\n" if (! defined $Clean::sortiefh);
  $Clean::sortiefh->autoflush;
  &main;
}
else
{
  &process_todo_file;
}

__DATA__

=head1 NAME

clean - clean your account...

=head1 SYNOPSIS

B<clean> [options] [directory]

with options in:

=over 4

[B<-a>] [B<--all>]
[B<-c>] [B<--check-only>]
[B<-d>] [B<--default>]
[B<-e>] [B<--delete-empty-dir>]
[B<-f>I<[filename]>] [B<--output>I<[=filename]>]
[B<-g>I<[#]>] [B<--gentle>I<[=#]>]
[B<-h>] [B<--help>]
[B<-i>] [B<--interactive>]
[B<-j>] [B<--empty-junk-dir>]
[B<-l>] [B<--follow-symbolic-links>]
[B<-m>I<modename>] [B<--mode>I<=modename>]
[B<-n>] [B<--no-recursion>]
[B<-o>] [B<--options>]
[B<-p>] [B<--process-todo-file>]
[B<-r>] [B<--generate-report>]
[B<-s>] [B<--silent>] [B<--quiet>]
[B<-u>] [B<--unprotect>]
[B<-v>] [B<--standard-output>]
[B<-w>] [B<--with-warnings>]
[B<-x>] [B<--strip-executables>]
[B<-z>] [B<--zap-invalid-links>]
[B<-C>] [B<--code-dump>]
[B<-D>] [B<--debug>]
[B<-V>] [B<--version>]

=back

=head1 OPTIONS

B<Note:> switch clustering is allowed when using short options. But be
sure to put last in a block any option that needs a parameter (C<-f>
for instance), for eveything that follows will be consdered as the
parameter.

=over 4

=item C<-a> or C<--all>

Deletes or compresses also optional files, i.e. files specified with
the C<DELOPT> and C<ZIPOPT> options. It cannot be specified in the
config file, it can only be given on the command line, for it is
intended to be used only when required. If that bothers you, you can
change your C<DELOPT> or C<ZIPOPT> options to C<DEL> and C<ZIP> ones,
or create an alternate config file (see the C<-m> option).

=item C<-c> or C<--check-only>

Check only. The files will not be deleted, compressed or stripped. You
will only get the names of the files to process. It is interesting if
you don't trust the program, and much more interesting when combined
with the C<-f> and C<-p> options (see below).

=item C<-d> or C<--default>

This option sets the default options :
non-interactive mode, no size report, messages printed on STDOUT, etc.
To get a full list, try C<clean -do>

=item C<-e> or C<--delete-empty-dir>

This option will make the script delete every empty directory it
finds. I implemented it upon request, so it will be useful to at
least one person (I hope).

=item C<-f>I<[filename]> or C<--output>I<[=filename]>

This option allows you to save the report to a file, rather than the
standard output (default). If I<filename> is not specified (ie only
C<-f> or C<--output>), the report will be saved in the file
F<$HOME/.clean-history>. The result can be parsed by the C<-p> option.

=item C<-g>I<[#]> or C<--gentle>I<[=#]>

Sets the nice level of the process. If no number is specified, the
default nice value is 10. On the systems that do not implement the
C<setpriority> function (e.g. Solaris 2.x), it will display a warning
and go on with normal priority.

=item C<-h> or C<--help>

Displays a help screen.

=item C<-i> or C<--interactive>

Interactive mode: asks wether to delete, compress, strip each file.

=item C<-j> or C<--empty-junk-dir>

Delete junk files in directories specified with the C<EMPTYDIR>
directive in the config file.

=item C<-l> or C<--follow-symbolic-links>

Follow symbolic links (for directories). By default, the program does
no directory recursion into symbolic links.

=item C<-m>I<modename> or C<--mode>I<=modename>

Activates another mode. This allows you to use different config files:
if you specify the option C<-m>B<mode>, the config file will be
changed to F<$HOME/.cleanrc-mode>, and will be read.  This option can
only be specified on the command-line. If you put it in the C<OPTIONS>
directive of your config file, it will be silently ignored.

=item C<-n> or C<--no-recursion>

Process only the files in the current or specified directory, do not
process subdirectories.

=item C<-o> or C<--options>

Displays the state of the current options, ie the options fixed in the
F<$HOME/.cleanrc> file, combined with the command line options
before the C<-o> flag. The program exits just after the display.

Note that the regexps are not displayed "as is", but that common
regexp parts (C<.+>, C<\.>) are replaced by the corresponding shell
metacharacters <C<*>, C<.>).

=item C<-p> or C<--process-todo-file>

Actually performs the actions suggested in the todo file (created with
C<clean -cf>). Here are the three lines that sum it all up:

    clean -cf            # Run clean in check-only mode
    vi ~/.clean-history  # Remove unwanted actions
    clean -pf            # Process the remaining todo file

=item C<-r> or C<--generate-report>

Gives a report about file sizes (total size, deleted files size, ...)

=item C<-s> or C<--silent> or C<--quiet>

Directs all messages to F</dev/null>, so you won't be distracted by the
reports. Maybe you'd better use the C<-f> option ?

=item C<-u> or C<--unprotect>

The protected directories list will not be taken into account, so you
can temporarily unprotect them to clean them.

=item C<-v> or C<--standard-output>

Prints the report and messages on the standard output (default).

=item C<-w> or C<--with-warnings>

Warns the user when a file is world-writable or empty.

=item C<-x> or C<--strip-executables>

Tests wether an executable is stripped ; if not, it will be stripped
with L<strip(1)> or the program specified with the directive
C<STRIP_PRG>.

=item C<-z> or C<--zap-invalid-links>

Deletes invalid symbolic links.

=item C<-C> or C<--code-dump>

Dumps the generated code, and stops. Merely for debugging purposes.

=item C<-D> or C<--debug>

Fixes the C<$debugmode> to 1. Internal use only.

=item C<-V> or C<--version>

Print the version number on the standard output and exit.

=back

=head1 DESCRIPTION

B<clean> deletes, compresses or strips the files that match a certain
regular expression, and a certain age.

It also can delete empty dirs, specified dirs, and invalid symbolic
links. It can empty temporary and cache dirs, and warn about
world-writable or empty files.

You can configure it through the file F<$HOME/.cleanrc>.

=head2 Syntax of the config file

All the lines have the same structure:

   command=parameters

You can add commentaries in your config file. They must begin with a
C<#>. Everything following a C<#> will be ignored.

Blank lines are also authorized.

=head2 Commands

=over 4

=item C<DEL>

tells what files are to be deleted. The parameters is a space
separated line with 3 elements: a perl-styled regexp that the filename
must match, how old it must be, and a comment. The last two parameters
are optional. For example,

    DEL=.+~	-1	# backup files

will erase all backup files. If the age is not relevant, put -1 or
nothing. No test will then be made on the age of the file.

=item C<DELOPT>

tells what files are to be optionnaly deleted, ie only when the
C<-a> flag is set. The parameters are the same as for the
C<DEL> command. For instance,

    DELOPT=.+\.o        # object files

will erase all object files. If the age is not relevant, put -1 or
nothing. No test will then be made on the age of the file.

=item C<ZIP>

tells what files are to be compressed. The parameters are the same as
for the C<DEL> command. For instance,

    ZIP=.+\.e?ps	30	# eps or ps files

will compress all postscript files older than 30 days.

=item C<ZIPOPT>

tells what files are to be optionnaly compressed, ie only when the
C<-a> flag is set. The parameters are the same as for the C<ZIP>
command. For instance,

    ZIPOPT=.+\.dvi	-1	# dvi files

will compress all dvi files

=item C<DELDIR>

tells what directories are to be deleted. The syntax is the same as
for the files (ie a regexp and a date field):

    DELDIR=\.wastebasket	-1

will delete the C<.wastebasket> directory.

=item C<EMPTYDIR>

tells what directories are to be emptied. The argument must be an
absolute pathname (and *NOT* a regexp), optionally followed by an age.
A C<~> in the pathname is expanded to home directory. If an age is
given, files are deleted only if they are older than the specified age
Classical use is:

    EMPTYDIR=/usr/tmp 3
    EMPTYDIR=~/.netscape/cache

This option is activated only when the C<-j> (junk directories)
options is set.

=item C<OPTIONS>

allows you to set default options. Note that the C<-d> switch sets
the builtin default options, not the ones set in the config file. For
instance,

    OPTIONS=-d -x -r

will set the default options, then the C<-x> option (strip executable
files), and then the C<-r> option (report).

These options can be overriden by the command line options. All the
options (these set in the config file, and the command line ones) are
read from left to right. So, if you specify

    OPTIONS=-f -v

where C<-f> means send output to the file F<$HOME/.clean-history>, and
C<-v> means send output to STDOUT, only the last one (STDOUT) will
be taken into account.

=item C<FILE_PRG>

allows you to specify the program that determines wether a file is
stripped or not. It must return one line with the words B<'not
stripped'>, when the file is not stripped. Its behaviour can be broken
on linux systems with a broken F</etc/magic> file, check before using
it.

The default value is F</usr/bin/file>.

=item C<ZIP_PRG>

allows you to specify the compression program. It must return 0 upon
success. The default value is F</bin/gzip -9 -q>

=item C<STRIP_PRG>

allows you to specify the program that strips the non-stripped
files. It must return 0 upon success. The default value is
F</usr/bin/strip>.

=item C<STRIP_AGE>

allows you to specify that the files newer than the given value (in
days) should not be stripped.

=item C<PROTECT>

allows you to protect directories. For example, when you're
developping, you don't want the object files to be deleted. You can
then protect the directory, and all its subdirectories. The parameter
must be an absolute path. For example,

    PROTECT=~/c

will protect the directory F<$HOME/c>. The script won't event try to
enter it. The ~ is expanded to your home directory.

=item C<HISTORY_FILE>

allows you to specify the file where messages should go to when the
C<-f> option is given. Its value can be overwritten by the value given
on the command-line.

=item C<HIDE_MESSAGE>

gives you the ability to hide some messages. You must give the display
level and an optional regexp. The most current use is to hide some
C<WARNING> messages.  B<Note:> you cannot use a whitespace in the regexp
(it is used as parameter delimiter), so use the \s class.

For example,

    HIDE_MESSAGE=WARNING is\sempty

will hide all warning messages containing the string "is empty".
B<Use with caution>. A badly written regexp could hide text that was
not intended to be hidden.

I know that the display levels are not documented. To know them, just
do a C<grep WARNING> on the program itself.

=back

=head1 NOTES

The config file location (default: F<$HOME/.cleanrc>) can be set in
the environment variable C<CLEANRC>.

There is a list of unauthorized regexps at the beginning of the
script. It is an attempt to improve security, as the script can be
very harmful. It also checks the permissions on the config file.

To see the default options, just run C<clean -o>.

The first time you run the program, it will ask you wether to create
the config file (answer yes, it cannot hurt), display the different
options, and stop. It will not do any deletions or compressions. You
will have to run it again to actually delete something.

If you don't trust the program, you can run C<clean -c>, which will
only print the things to do (files to delete, files to compress,
etc...) without actually doing it, so you can check that its choices
are right.

See also the part about the C<-p> option (and the example).

=head1 QUOTES

From the Jargon File (3.3.1) :

=over 8

=item

:clean: 1. adj.  Used of hardware or software designs, implies
`elegance in the small', that is, a design or implementation that may
not hold any surprises but does things in a way that is reasonably
intuitive and relatively easy to comprehend from the outside.  The
antonym is `grungy' or {crufty}.  2. v. To remove unneeded or
undesired files in a effort to reduce clutter: "I'm cleaning up my
account."  "I cleaned up the garbage and now have 100 Meg free on that
partition."

And from the old System V.2 administrator's guide:

"Making files is easy under the  Unix operating system. Therefore,
users tend to  create numerous files  using large amounts of file
space. It  has been said that  the only  standard thing about all
Unix systems is the message-of-the-day  telling users to clean up
their files."

=back

=head1 EXAMPLES

C<clean -cf; vi ~/.clean-history; clean -pf>

which does a check-only run with the result in the F<~/.clean-history>
file, lets you edit it to remove unwanted actions and then processes
it.

C<clean -gwx>

cleans the current directory with warnings on, a nice priority and
trying to spot unstripped executables.

=head1 ENVIRONMENT

C<CLEANRC> : path of the configuration file.

C<PATH>    : used to determine the absolute path to F<gzip>, F<file> and F<strip>

C<GZIP>    : used by F<gzip>

=head1 FILES

F<$HOME/.cleanrc>

F<$HOME/.clean-history>

=head1 SEE ALSO

L<perl(1)>, L<strip(1)>, L<file(1)>, L<gzip(1)>, L<du(1)>, L<quota(1)>

=head1 AUTHOR

Olivier AUBERT C<E<lt>Olivier.Aubert@enst-bretagne.frE<gt>>

based on an idea by Olivier MORBE.

=head1 BUGS

There should be some sneaky ones lying around, just waiting for some poor
user to come within its reach. Be careful...

The filesize report is not very accurate (or maybe too much). It does
not round the size to the block size as C<du(1)> does.

=cut

You shoud not see this... If you do, then it's a bug in the POD
converter you used.