debian/cvs-clean.pl

   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 licence. 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
  15 sub 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
  32 sub newfiles()
  33 {
  34   my ($indir, $incvs) = @_;
  35   for my $n (keys (%$incvs)) { delete $$indir{$n} }
  36   return sort (keys (%$indir));
  37 }
  38
  39 sub 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 ("");