mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-11-04 09:39:43 +01:00 
			
		
		
		
	added delete_non_svn_files.pl
git-svn-id: trunk@11483 -
This commit is contained in:
		
							parent
							
								
									df7d6b0427
								
							
						
					
					
						commit
						0873aad7ec
					
				
							
								
								
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							@ -3055,6 +3055,7 @@ tools/convert_po_file_to_utf-8.sh svneol=native#text/plain
 | 
			
		||||
tools/copy_po_files_to_lazarus_sources.sh -text svneol=native#application/x-sh
 | 
			
		||||
tools/cvs2cl.pl -text svneol=native#application/x-perl
 | 
			
		||||
tools/delete_non_cvs_files.pl -text svneol=native#application/x-perl
 | 
			
		||||
tools/delete_non_svn_files.pl svneol=native#text/plain
 | 
			
		||||
tools/find_non_cvs_files.pl -text svneol=native#application/x-perl
 | 
			
		||||
tools/getallmofiles.sh -text svneol=native#application/x-sh
 | 
			
		||||
tools/getallpofiles.sh -text svneol=native#application/x-sh
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										135
									
								
								tools/delete_non_svn_files.pl
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										135
									
								
								tools/delete_non_svn_files.pl
									
									
									
									
									
										Executable file
									
								
							@ -0,0 +1,135 @@
 | 
			
		||||
#!/usr/bin/env perl
 | 
			
		||||
#
 | 
			
		||||
# *****************************************************************************
 | 
			
		||||
# *                                                                           *
 | 
			
		||||
# *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 | 
			
		||||
# *  for details about the copyright.                                         *
 | 
			
		||||
# *                                                                           *
 | 
			
		||||
# *  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.                     *
 | 
			
		||||
# *                                                                           *
 | 
			
		||||
# *****************************************************************************
 | 
			
		||||
#
 | 
			
		||||
# Author: Mattias Gaertner
 | 
			
		||||
#
 | 
			
		||||
# This perl script deletes all files not in CVS.
 | 
			
		||||
 | 
			
		||||
use vars qw/ %opt /;
 | 
			
		||||
use Getopt::Std;
 | 
			
		||||
use Cwd;
 | 
			
		||||
my $opt_string = 'hd:rflqx';
 | 
			
		||||
getopts( "$opt_string", \%opt ) or usage();
 | 
			
		||||
usage() if $opt{h};
 | 
			
		||||
 | 
			
		||||
sub usage(){
 | 
			
		||||
  print STDERR << "EOF";
 | 
			
		||||
 | 
			
		||||
Delete all files not in CVS
 | 
			
		||||
 | 
			
		||||
usage: $0 [-hdrflqx]
 | 
			
		||||
 | 
			
		||||
 -h             : this (help) message
 | 
			
		||||
 -d <directory> : the directory where to search for files, default: current dir
 | 
			
		||||
 -r             : recursive: search in sub directories too
 | 
			
		||||
 -f             : delete only files, not directories
 | 
			
		||||
 -q             : quiet
 | 
			
		||||
 -x             : really delete them, default: simulate
 | 
			
		||||
 | 
			
		||||
examples:
 | 
			
		||||
  delete_non_cvs_files.pl -r -d /your/lazarus/path
 | 
			
		||||
 | 
			
		||||
EOF
 | 
			
		||||
  exit;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
if (!$opt{d}){
 | 
			
		||||
  $opt{d}=&getcwd;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
$StartDir=$opt{d};
 | 
			
		||||
(-d $StartDir) || die "directory $StartDir is not a directory\n";
 | 
			
		||||
$StartDir=~s#//#/#g;
 | 
			
		||||
$StartDir=~s#/$##g;
 | 
			
		||||
 | 
			
		||||
&SearchDir($StartDir);
 | 
			
		||||
 | 
			
		||||
if(!$opt{x}){
 | 
			
		||||
  print "\nThis was a simulation. To really delete files, use the -x option.\n";
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
exit;
 | 
			
		||||
 | 
			
		||||
sub SearchDir(){
 | 
			
		||||
  (my $CurDir)=@_;
 | 
			
		||||
  my $line;
 | 
			
		||||
  my $SVNFiles;
 | 
			
		||||
  my @Files;
 | 
			
		||||
  my $i;
 | 
			
		||||
  my $CurFile;
 | 
			
		||||
  my $CurFullFile;
 | 
			
		||||
 | 
			
		||||
  if($opt{r}){
 | 
			
		||||
    # search recursive
 | 
			
		||||
    # get files
 | 
			
		||||
    opendir(DIR, $CurDir);
 | 
			
		||||
    @Files = readdir(DIR);
 | 
			
		||||
    closedir(DIR);
 | 
			
		||||
    for ($i=0; $i<=$#Files; $i++){
 | 
			
		||||
      $CurFile=$Files[$i];
 | 
			
		||||
      $CurFullFile=$CurDir."/".$CurFile;
 | 
			
		||||
      # skip special files
 | 
			
		||||
      next unless ($CurFile);
 | 
			
		||||
      next if (($CurFile eq '.') || ($CurFile eq '..') || ($CurFile eq '.svn'));
 | 
			
		||||
      &SearchDir($CurFullFile);
 | 
			
		||||
    }
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  # get files
 | 
			
		||||
  opendir(DIR, $CurDir);
 | 
			
		||||
  @Files = readdir(DIR);
 | 
			
		||||
  closedir(DIR);
 | 
			
		||||
  for ($i=0; $i<=$#Files; $i++){
 | 
			
		||||
    $CurFile=$Files[$i];
 | 
			
		||||
    $CurFullFile=$CurDir."/".$CurFile;
 | 
			
		||||
    # skip special files
 | 
			
		||||
    next unless ($CurFile);
 | 
			
		||||
    next if (($CurFile eq '.') || ($CurFile eq '..') || ($CurFile eq '.svn'));
 | 
			
		||||
    # skip directories if not wanted
 | 
			
		||||
    next if (($opt{f}) && (-d $CurFullFile));
 | 
			
		||||
    # search file in SVN files
 | 
			
		||||
    $Output=`svn info $CurFullFile 2>&1`;
 | 
			
		||||
    #print "AAA1 $CurFullFile: $? BBB1$Output BBB2 \n";
 | 
			
		||||
    if ($Output!~/\nURL:/){
 | 
			
		||||
      if (-d $CurFullFile){
 | 
			
		||||
        print "rmdir ".$CurFullFile."\n";
 | 
			
		||||
      } else {
 | 
			
		||||
        if (!$opt{q}){
 | 
			
		||||
          print "unlink ".$CurFullFile."\n";
 | 
			
		||||
        }
 | 
			
		||||
      }
 | 
			
		||||
      if($opt{x}){
 | 
			
		||||
        if (-d $CurFullFile){
 | 
			
		||||
          rmdir($CurFullFile);
 | 
			
		||||
        } else {
 | 
			
		||||
          unlink($CurFullFile);
 | 
			
		||||
        }
 | 
			
		||||
      }
 | 
			
		||||
    }
 | 
			
		||||
  }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub DoIt(){
 | 
			
		||||
  (my $Command)=@_;
 | 
			
		||||
  print $Command."\n";
 | 
			
		||||
  if($opt{x}){
 | 
			
		||||
    my $Output=`$Command`;
 | 
			
		||||
    if($?){
 | 
			
		||||
      die "Command failed:\n".$Output;
 | 
			
		||||
    }
 | 
			
		||||
    print $Output;
 | 
			
		||||
  }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# end.
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user