11a162b0e5
In case we have a git clone from Linux that is accessed via cygwin git the files executable status will be derived from the file content (shebang) and won't match the git repo, leading to a initially dirty tree. This can be worked around by setting "core.filemode=false", but let's try to match the cygwin permissions with the in-repo permissions so this isn't needed.
247 lines
6.4 KiB
Perl
Executable File
247 lines
6.4 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# svn-clean - Wipes out unversioned files from SVN working copy.
|
|
# Copyright (C) 2004, 2005, 2006 Simon Perreault
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU General Public License
|
|
# as published by the Free Software Foundation; either version 2
|
|
# of the License, or (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
|
|
use strict;
|
|
use Cwd;
|
|
use File::Path;
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
|
|
# Try to use SVN module if available.
|
|
my $use_svn_module = eval { require SVN::Client };
|
|
|
|
my $CWD = getcwd;
|
|
|
|
my @exclude = ();
|
|
my $force = 0;
|
|
my $quiet = 0;
|
|
my $print = 0;
|
|
my $help = 0;
|
|
my $man = 0;
|
|
my $nonrecursive = 0;
|
|
my @paths = ($CWD);
|
|
GetOptions(
|
|
"exclude=s" => \@exclude,
|
|
"force" => \$force,
|
|
"non-recursive|N" => \$nonrecursive,
|
|
"quiet" => \$quiet,
|
|
"print" => \$print,
|
|
"help|?" => \$help,
|
|
"man" => \$man
|
|
) or pod2usage(2);
|
|
pod2usage(1) if $help;
|
|
pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;
|
|
@paths = map { Cwd::abs_path($_) } @ARGV if @ARGV;
|
|
|
|
# Precompile regexes.
|
|
$_ = qr/$_/ foreach @exclude;
|
|
|
|
if ($use_svn_module) {
|
|
|
|
# Create SVN client object. No need for connection to remote server.
|
|
my $ctx = new SVN::Client;
|
|
|
|
# Call handler function with status info for each file.
|
|
$ctx->status( $_, undef, \&clean, !$nonrecursive, 1, 0, 1 )
|
|
for @paths;
|
|
}
|
|
else {
|
|
warn "Warning: Not using SVN Perl modules, this might be slow.\n"
|
|
unless $quiet;
|
|
|
|
# Build svn client command
|
|
my @command = qw(svn status --no-ignore -v);
|
|
if ($nonrecursive) {
|
|
push @command, '-N';
|
|
}
|
|
|
|
# Main file-wiping loop.
|
|
if ( $^O eq 'MSWin32' ) {
|
|
|
|
# Perl on Windows currently doesn't have list pipe opens.
|
|
open SVN, join( ' ', @command, @paths ) . '|'
|
|
or die "Can't call program \"svn\": $!\n";
|
|
}
|
|
else {
|
|
open SVN, "-|", @command, @paths
|
|
or die "Can't call program \"svn\": $!\n";
|
|
}
|
|
LINE: while (<SVN>) {
|
|
if (/^([\?ID])/) {
|
|
my $file = (split)[-1];
|
|
foreach my $ex (@exclude) {
|
|
if ( $file =~ $ex ) {
|
|
print "excluded $file\n" unless $quiet or $print;
|
|
next LINE;
|
|
}
|
|
}
|
|
if ( $1 eq 'D' ) {
|
|
next unless -f $file;
|
|
}
|
|
else {
|
|
next unless -e $file;
|
|
}
|
|
if ($print) {
|
|
print "$file\n";
|
|
}
|
|
else {
|
|
rmtree( $file, !$quiet, !$force );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Main file-wiping function.
|
|
sub clean {
|
|
my ( $path, $status ) = @_;
|
|
|
|
# Use relative path for pretty-printing.
|
|
if ( $path =~ s/^\Q$CWD\E\/?//o ) {
|
|
|
|
# If the substitution succeeded, we should have a relative path. Make
|
|
# sure we don't delete critical stuff.
|
|
return if $path =~ /^\//;
|
|
}
|
|
|
|
# Find files needing to be removed.
|
|
if ( $status->text_status == $SVN::Wc::Status::unversioned
|
|
or $status->text_status == $SVN::Wc::Status::ignored
|
|
or $status->text_status == $SVN::Wc::Status::deleted )
|
|
{
|
|
foreach my $ex (@exclude) {
|
|
if ( $path =~ $ex ) {
|
|
print "excluded $path\n" unless $quiet or $print;
|
|
return;
|
|
}
|
|
}
|
|
|
|
# Make sure the file exists before removing it. Do not remove deleted
|
|
# directories as they are needed to remove the files they contain when
|
|
# committing.
|
|
lstat $path or stat $path;
|
|
if (
|
|
-e _
|
|
and ( not -d _
|
|
or $status->text_status != $SVN::Wc::Status::deleted )
|
|
)
|
|
{
|
|
if ($print) {
|
|
print "$path\n";
|
|
}
|
|
else {
|
|
rmtree( $path, !$quiet, !$force );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
svn-clean - Wipes out unversioned files from Subversion working copy
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
svn-clean [options] [directory or file ...]
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
B<svn-clean> will scan the given files and directories recursively and find
|
|
unversioned files and directories (files and directories that are not present in
|
|
the Subversion repository). After the scan is done, these files and directories
|
|
will be deleted.
|
|
|
|
If no file or directory is given, B<svn-clean> defaults to the current directory
|
|
(".").
|
|
|
|
B<svn-clean> uses the SVN Perl modules if they are available. This is much
|
|
faster than parsing the output of the B<svn> command-line client.
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 8
|
|
|
|
=item B<-e>, B<--exclude>
|
|
|
|
A regular expression for filenames to be exluded. For example, the following
|
|
command will skip files ending in ".zip":
|
|
|
|
=over 8
|
|
|
|
svn-clean --exclude '\.zip$'
|
|
|
|
=back
|
|
|
|
Multiple exclude patterns can be specified. If at least one matches, then the
|
|
file is skipped. For example, the following command will skip files ending in
|
|
".jpg" or ".png":
|
|
|
|
=over 8
|
|
|
|
svn-clean --exclude '\.jpg$' --exclude '\.png$'
|
|
|
|
=back
|
|
|
|
The following command will skip the entire "build" subdirectory:
|
|
|
|
=over 8
|
|
|
|
svn-clean --exclude '^build(/|$)'
|
|
|
|
=back
|
|
|
|
=item B<-f>, B<--force>
|
|
|
|
Files to which you do not have delete access (if running under VMS) or write
|
|
access (if running under another OS) will not be deleted unless you use this
|
|
option.
|
|
|
|
=item B<-N>, B<--non-recursive>
|
|
|
|
Do not search recursively for unversioned files and directories. Unversioned
|
|
directories will still be deleted along with all their contents.
|
|
|
|
=item B<-q>, B<--quiet>
|
|
|
|
Do not print progress info. In particular, do not print a message each time a
|
|
file is examined, giving the name of the file, and indicating whether "rmdir" or
|
|
"unlink" is used to remove it, or that it's skipped.
|
|
|
|
=item B<-p>, B<--print>
|
|
|
|
Do not delete anything. Instead, print the name of every file and directory that
|
|
would have been deleted.
|
|
|
|
=item B<-?>, B<-h>, B<--help>
|
|
|
|
Prints a brief help message and exits.
|
|
|
|
=item B<--man>
|
|
|
|
Prints the manual page and exits.
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Simon Perreault <nomis80@nomis80.org>
|
|
|
|
=cut
|