contrib/client-side/svn-clean

   1 #!/usr/bin/perl
   2
   3 # svn-clean - Wipes out unversioned files from SVN working copy.
   4 # Copyright (C) 2004, 2005, 2006 Simon Perreault
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License
   8 # as published by the Free Software Foundation; either version 2
   9 # of the License, or (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  19
  20 use strict;
  21 use Cwd;
  22 use File::Path;
  23 use Getopt::Long;
  24 use Pod::Usage;
  25
  26 # Try to use SVN module if available.
  27 my $use_svn_module = eval { require SVN::Client };
  28
  29 my $CWD = getcwd;
  30
  31 my @exclude      = ();
  32 my $force        = 0;
  33 my $quiet        = 0;
  34 my $print        = 0;
  35 my $help         = 0;
  36 my $man          = 0;
  37 my $nonrecursive = 0;
  38 my $path         = $CWD;
  39 GetOptions(
  40     "exclude=s"       => \@exclude,
  41     "force"           => \$force,
  42     "non-recursive|N" => \$nonrecursive,
  43     "quiet"           => \$quiet,
  44     "print"           => \$print,
  45     "help|?"          => \$help,
  46     "man"             => \$man
  47 ) or pod2usage(2);
  48 pod2usage(1) if $help;
  49 pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;
  50 $path = Cwd::abs_path( $ARGV[0] ) if @ARGV;
  51
  52 # Precompile regexes.
  53 $_ = qr/$_/ foreach @exclude;
  54
  55 if ($use_svn_module) {
  56
  57     # Create SVN client object. No need for connection to remote server.
  58     my $ctx = new SVN::Client;
  59
  60     # Call handler function with status info for each file.
  61     $ctx->status( $path, undef, \&clean, !$nonrecursive, 1, 0, 1 );
  62 }
  63 else {
  64     warn "Warning: Not using SVN Perl modules, this might be slow.\n"
  65       unless $quiet;
  66
  67     # Build svn client command
  68     my @command = qw(svn status --no-ignore -v);
  69     if ($nonrecursive) {
  70         push @command, '-N';
  71     }
  72
  73     # Main file-wiping loop.
  74     if ( $^O eq 'MSWin32' ) {
  75
  76         # Perl on Windows currently doesn't have list pipe opens.
  77         open SVN, join( ' ', @command, @ARGV ) . '|'
  78           or die "Can't call program \"svn\": $!\n";
  79     }
  80     else {
  81         open SVN, "-|", @command, @ARGV
  82           or die "Can't call program \"svn\": $!\n";
  83     }
  84   LINE: while (<SVN>) {
  85         if (/^([\?ID])/) {
  86             my $file = (split)[-1];
  87             foreach my $ex (@exclude) {
  88                 if ( $file =~ $ex ) {
  89                     print "excluded $file\n" unless $quiet or $print;
  90                     next LINE;
  91                 }
  92             }
  93             if ( $1 eq 'D' ) {
  94                 next unless -f $file;
  95             }
  96             else {
  97                 next unless -e $file;
  98             }
  99             if ($print) {
 100                 print "$file\n";
 101             }
 102             else {
 103                 rmtree( $file, !$quiet, !$force );
 104             }
 105         }
 106     }
 107 }
 108
 109 # Main file-wiping function.
 110 sub clean {
 111     my ( $path, $status ) = @_;
 112
 113     # Use relative path for pretty-printing.
 114     if ( $path =~ s/^\Q$CWD\E\/?//o ) {
 115
 116         # If the substitution succeeded, we should have a relative path. Make
 117         # sure we don't delete critical stuff.
 118         return if $path =~ /^\//;
 119     }
 120
 121     # Find files needing to be removed.
 122     if (   $status->text_status == $SVN::Wc::Status::unversioned
 123         or $status->text_status == $SVN::Wc::Status::ignored
 124         or $status->text_status == $SVN::Wc::Status::deleted )
 125     {
 126         foreach my $ex (@exclude) {
 127             if ( $path =~ $ex ) {
 128                 print "excluded $path\n" unless $quiet or $print;
 129                 return;
 130             }
 131         }
 132
 133         # Make sure the file exists before removing it. Do not remove deleted
 134         # directories as they are needed to remove the files they contain when
 135         # committing.
 136         lstat $path or stat $path;
 137         if (
 138             -e _
 139             and ( not -d _
 140                 or $status->text_status != $SVN::Wc::Status::deleted )
 141           )
 142         {
 143             if ($print) {
 144                 print "$path\n";
 145             }
 146             else {
 147                 rmtree( $path, !$quiet, !$force );
 148             }
 149         }
 150     }
 151 }
 152
 153 __END__
 154
 155 =head1 NAME
 156
 157 svn-clean - Wipes out unversioned files from Subversion working copy
 158
 159 =head1 SYNOPSIS
 160
 161 svn-clean [options] [directory or file ...]
 162
 163 =head1 DESCRIPTION
 164
 165 B<svn-clean> will scan the given files and directories recursively and find
 166 unversioned files and directories (files and directories that are not present in
 167 the Subversion repository). After the scan is done, these files and directories
 168 will be deleted.
 169
 170 If no file or directory is given, B<svn-clean> defaults to the current directory
 171 (".").
 172
 173 B<svn-clean> uses the SVN Perl modules if they are available. This is much
 174 faster than parsing the output of the B<svn> command-line client.
 175
 176 =head1 OPTIONS
 177
 178 =over 8
 179
 180 =item B<-e>, B<--exclude>
 181
 182 A regular expression for filenames to be exluded. For example, the following
 183 command will skip files ending in ".zip":
 184
 185 =over 8
 186
 187 svn-clean --exclude '\.zip$'
 188
 189 =back
 190
 191 Multiple exclude patterns can be specified. If at least one matches, then the
 192 file is skipped. For example, the following command will skip files ending in
 193 ".jpg" or ".png":
 194
 195 =over 8
 196
 197 svn-clean --exclude '\.jpg$' --exclude '\.png$'
 198
 199 =back
 200
 201 The following command will skip the entire "build" subdirectory:
 202
 203 =over 8
 204
 205 svn-clean --exclude '^build(/|$)'
 206
 207 =back
 208
 209 =item B<-f>, B<--force>
 210
 211 Files to which you do not have delete access (if running under VMS) or write
 212 access (if running under another OS) will not be deleted unless you use this
 213 option.
 214
 215 =item B<-N>, B<--non-recursive>
 216
 217 Do not search recursively for unversioned files and directories. Unversioned
 218 directories will still be deleted along with all their contents.
 219
 220 =item B<-q>, B<--quiet>
 221
 222 Do not print progress info. In particular, do not print a message each time a
 223 file is examined, giving the name of the file, and indicating whether "rmdir" or
 224 "unlink" is used to remove it, or that it's skipped.
 225
 226 =item B<-p>, B<--print>
 227
 228 Do not delete anything. Instead, print the name of every file and directory that
 229 would have been deleted.
 230
 231 =item B<-?>, B<-h>, B<--help>
 232
 233 Prints a brief help message and exits.
 234
 235 =item B<--man>
 236
 237 Prints the manual page and exits.
 238
 239 =back
 240
 241 =head1 AUTHOR
 242
 243 Simon Perreault <nomis80@nomis80.org>
 244
 245 =cut