Clean.tcl

   1 #!/usr/bin/env tclsh
   2
   3 # Clean.tcl
   4 #       This script is used to remove all unwanted files from a
   5 #       directory not in the .clean file list. This should only
   6 #       be used by maintainers when producing a release.
   7
   8 # Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
   9 #
  10 # This program is free software; you can redistribute it and/or modify
  11 # it under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation; either version 2 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program; if not, write to the Free Software
  22 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 # Please email any bugs, comments, and/or additions to this file to:
  25 # bug-dejagnu@gnu.org
  26
  27 # This file was written by Rob Savoye. (rob@welcomehome.org)
  28
  29 # default to no verbosity
  30 if ![info exists verbose] {
  31     set verbose 0
  32 }
  33
  34 proc usage { } {
  35     puts "USAGE: Clean.tcl \[options...\]"
  36     puts "\t--verbose (-v)\t\tPrint all test output to screen"
  37 }
  38
  39 # print a message if it's verbosity is greater than the default
  40 proc verbose { args } {
  41     global verbose
  42     set newline 1
  43
  44     set i 0
  45     if { [string index [lindex $args 0] 0] == "-" } {
  46         for { set i 0 } { $i < [llength $args] } { incr i } {
  47             if { [lindex $args $i] == "--" } {
  48                 incr i
  49                 break
  50             } elseif { [lindex $args $i] == "-n" } {
  51                 set newline 0
  52             } elseif { [string index [lindex $args $i] 0] == "-" } {
  53                 puts "ERROR: verbose: illegal argument: [lindex $args $i]"
  54                 return
  55             } else {
  56                 break
  57             }
  58         }
  59         if { [llength $args] == $i } {
  60             puts "ERROR: verbose: nothing to print"
  61             return
  62         }
  63     }
  64
  65     set level 1
  66     if { [llength $args] > $i + 1 } {
  67         set level [lindex $args [expr $i+1]]
  68     }
  69     set message [lindex $args $i]
  70
  71     if { $verbose >= $level } {
  72         # There is no need for the "--" argument here, but play it safe.
  73         # We assume send_user also sends the text to the log file (which
  74         # appears to be the case though the docs aren't clear on this).
  75         if { $newline } {
  76             puts -nonewline "$message\n"
  77         } else {
  78             puts -nonewline "$message"
  79         }
  80     }
  81 }
  82
  83 # process the command line arguments
  84 for { set i 0 } { $i < $argc } { incr i } {
  85     set option [lindex $argv $i]
  86
  87     # make all options have two hyphens
  88     switch -glob -- $option {
  89         "--*" {
  90         }
  91         "-*" {
  92             set option "-$option"
  93         }
  94     }
  95
  96
  97     switch -glob -- $option {
  98         "--he*" {                       # (--help) help text
  99             usage
 100             exit 0
 101         }
 102
 103         "--v" -
 104         "--verb*" {                     # (--verbose) verbose output
 105             incr verbose
 106             continue
 107         }
 108     }
 109 }
 110 verbose "Verbose level is $verbose" 2
 111
 112 proc cleanfiles { directory } {
 113     set filelist ""
 114
 115     # get a list of all the files in this directory
 116     set allfiles [glob -nocomplain "$directory/*"]
 117     concat allfiles [glob -nocomplain -type f "$directory/.*"]
 118     regsub -all "$directory/" $allfiles "" allfiles
 119
 120     # open the .clean file, which has the list of stuff we
 121     # want to save
 122     catch "set cleanfile [open "$directory/.clean" r]"
 123     if ![info exists cleanfile] {
 124         verbose "WARNING: no .clean file in $directory, removing the default set of \"*! core CVS RCS\"" 3
 125         set allfiles [glob -nocomplain "$directory/*~"]
 126         append allfiles " [glob -nocomplain "$directory/core*"]"
 127         append allfiles " [glob -nocomplain "$directory/CVS"]"
 128         append allfiles " [glob -nocomplain "$directory/Cvs.*"]"
 129         append allfiles " [glob -nocomplain "$directory/*.out"]"
 130         append allfiles " [glob -nocomplain "$directory/*.dvi"]"
 131         append allfiles " [glob -nocomplain "$directory/*.rej"]"
 132         append allfiles " [glob -nocomplain "$directory/*.orig"]"
 133         append allfiles " [glob -nocomplain "$directory/*.log"]"
 134         append allfiles " [glob -nocomplain "$directory/*.cvsignore"]"
 135         append allfiles " [glob -nocomplain "$directory/*.tgz"]"
 136         append allfiles " [glob -nocomplain "$directory/*.tar.gz"]"
 137         append allfiles " [glob -nocomplain "$directory/autom4te.cache"]"
 138         append allfiles " [glob -nocomplain "$directory/RCS"]"
 139         append allfiles " [glob -nocomplain "$directory/.\#*"]"
 140     } else {
 141         # read in the .clean file, line by line
 142         while { [gets $cleanfile cur_line]>=0 } {
 143             # ignore comments
 144             if { [string index $cur_line 0] == "\#" } {
 145                 verbose "Ignoring comment" 2
 146                 continue
 147             }
 148             # ignore blank lines
 149             if { [string length $cur_line]<=0 } {
 150                 verbose "Ignoring blank line" 2
 151                 continue
 152             }
 153             regsub -all "\[\+\]" $cur_line "\\+" cur_line
 154             # remove the filename from the list
 155             regsub -all " $cur_line " $allfiles " " allfiles
 156             # also match the name if it's the last one in the file
 157             regsub -all " $cur_line$" $allfiles " " allfiles
 158             # also match if it's the only name in the list
 159             regsub -all "^$cur_line" $allfiles " " allfiles
 160         }
 161     }
 162
 163     # remove the leading and trailing blank spaces for cleanliness sake
 164     set allfiles [string trimleft $allfiles]
 165     set allfiles [string trimright $allfiles]
 166     # nuke the files
 167     if { [string length $allfiles] > 0 } {
 168         verbose "Removing \"$allfiles\" from $directory"
 169         catch "exec rm -fr $allfiles"
 170     } else {
 171         verbose "Nothing to remove from $directory" 2
 172     }
 173
 174     # close the .clean file
 175     catch "close $cleanfile"
 176 }
 177
 178
 179 # now that we've removed everything we don't want from this
 180 # directory, recur into the directories that are left to clean
 181 # those as well.
 182
 183 proc getdirs { directory } {
 184     set dirs ""
 185     set files [glob -nocomplain "$directory/*"]
 186     if { [llength $files] != 0 } {
 187         foreach j $files {
 188             if [file isdirectory $j] {
 189                 append dirs " $j"
 190                 append dirs " [getdirs $j]"
 191             }
 192         }
 193     }
 194     return $dirs
 195 }
 196
 197 cleanfiles .
 198 # now we actually do it all
 199 foreach i [getdirs .] {
 200     cleanfiles $i
 201 }
 202
 203
 204
 205