source: branches/start/Taper/admin/cvs-clean.pl@ 9029

Last change on this file since 9029 was 4307, checked in by merck, 20 years ago
new project
File size: 2.0 KB
Line 
1#! /usr/bin/perl
2
3#
4# This script recursively (beginning with the current directory)
5# wipes out everything not registered in CVS.
6#
7# written by Oswald Buddenhagen <ossi@kde.org>
8# inspired by the "old" cvs-clean target from Makefile.common
9#
10# This file is free software in terms of the BSD license. That means
11# that you can do anything with it except removing this license or
12# the above copyright notice. There is NO WARRANTY of any kind.
13#
14
15sub rmrf()
16{
17 my $fn = shift;
18 lstat ($fn);
19 if (-d _) {
20 if (opendir (DIR, $fn)) {
21 for my $efn (grep (!/^\.\.?$/, readdir (DIR))) {
22 &rmrf ($fn."/".$efn);
23 }
24 closedir (DIR);
25 rmdir ($fn);
26 }
27 } else {
28 unlink ($fn);
29 }
30}
31
32sub newfiles()
33{
34 my ($indir, $incvs) = @_;
35 for my $n (keys (%$incvs)) { delete $$indir{$n} }
36 return sort (keys (%$indir));
37}
38
39sub cvsclean()
40{
41 my $dir = shift;
42 my (%dirsdir, %filesdir, %dirscvs, %filescvs);
43 my $dnam = $dir ? $dir : ".";
44 if (!opendir (DIR, $dnam)) {
45 print STDERR "Cannot enter \"".$dnam."\".\n";
46 return;
47 }
48 for my $fn (grep (!/^\.\.?$/, readdir (DIR))) {
49 if (-d $dir.$fn) {
50 $fn eq "CVS" or $dirsdir{$fn} = 1;
51 } else {
52 $filesdir{$fn} = 1;
53 }
54 }
55 closedir (DIR);
56 if (!open (FILE, "<".$dir."CVS/Entries")) {
57 print STDERR "No CVS information in \"".$dnam."\".\n";
58 return;
59 }
60 while (<FILE>) {
61 m%^D/([^/]+)/.*$% and $dirscvs{$1} = 1;
62 m%^/([^/]+)/.*$% and $filescvs{$1} = 1;
63 }
64 close (FILE);
65 if (open (FILE, "<".$dir."CVS/Entries.Log")) {
66 while (<FILE>) {
67 m%^A D/([^/]+)/.*$% and $dirscvs{$1} = 1;
68 m%^A /([^/]+)/.*$% and $filescvs{$1} = 1;
69 m%^R D/([^/]+)/.*$% and delete $dirscvs{$1};
70 m%^R /([^/]+)/.*$% and delete $filescvs{$1};
71 }
72 close (FILE);
73 }
74 for my $fn (&newfiles (\%filesdir, \%filescvs)) {
75 print ("F ".$dir.$fn."\n");
76 &rmrf ($dir.$fn);
77 }
78 for my $fn (&newfiles (\%dirsdir, \%dirscvs)) {
79 print ("D ".$dir.$fn."\n");
80 &rmrf ($dir.$fn);
81 }
82 for my $fn (sort (keys (%dirscvs))) {
83 &cvsclean ($dir.$fn."/");
84 }
85}
86
87&cvsclean ("");
Note: See TracBrowser for help on using the repository browser.