#! /usr/bin/env perl

#
# This script recursively (beginning with the current directory)
# wipes out everything not registered in CVS.
#
# written by Oswald Buddenhagen <ossi@kde.org>
#  inspired by the "old" cvs-clean target from Makefile.common
#
# This file is free software in terms of the BSD licence. That means
# that you can do anything with it except removing this license or
# the above copyright notice. There is NO WARRANTY of any kind.
#

use File::Path;

my $dry_run = 0;

sub newfiles()
{
  my ($indir, $incvs) = @_;
  for my $n (keys (%$incvs)) { delete $$indir{$n} }
  return sort (keys (%$indir));
}

sub cvsclean()
{
  my $dir = shift;
  my (%dirsdir, %filesdir, %dirscvs, %filescvs);
  my $dnam = $dir ? $dir : ".";
  if (!opendir (DIR, $dnam)) {
    print STDERR "Cannot enter \"".$dnam."\".\n";
    return;
  }
  for my $fn (grep (!/^\.\.?$/, readdir (DIR))) {
    if (-d $dir.$fn) {
      $fn eq "CVS" or $dirsdir{$fn} = 1;
    } else {
      $filesdir{$fn} = 1;
    }
  }
  closedir (DIR);
  if (!open (FILE, "<".$dir."CVS/Entries")) {
    print STDERR "No CVS information in \"".$dnam."\".\n";
    return;
  }
  while (<FILE>) {
    m%^D/([^/]+)/.*$% and $dirscvs{$1} = 1;
    m%^/([^/]+)/.*$% and $filescvs{$1} = 1;
  }
  close (FILE);
  if (open (FILE, "<".$dir."CVS/Entries.Log")) {
    while (<FILE>) {
      m%^A D/([^/]+)/.*$% and $dirscvs{$1} = 1;
      m%^A /([^/]+)/.*$% and $filescvs{$1} = 1;
      m%^R D/([^/]+)/.*$% and delete $dirscvs{$1};
      m%^R /([^/]+)/.*$% and delete $filescvs{$1};
    }
    close (FILE);
  }
  for my $fn (&newfiles (\%filesdir, \%filescvs)) {
    print ("F ".$dir.$fn."\n");
    unlink($dir.$fn) unless $dry_run;
  }
  for my $fn (&newfiles (\%dirsdir, \%dirscvs)) {
    print ("D ".$dir.$fn."\n");
    rmtree($dir.$fn, 0, 0) unless $dry_run;
  }
  for my $fn (sort (keys (%dirscvs))) {
    &cvsclean ($dir.$fn."/");
  }
}

my $usage = 
  "usage: cvs-clean [options]\n".
  "    --help | -h      print usage information\n".
  "    --dry-run | -n   print intended actions; don't change filesystem\n";

foreach my $arg (@ARGV) {
  if ($arg eq '-h' || $arg eq '--help') {
    print $usage;
    exit (0);
  } elsif ($arg eq '-n' || $arg eq '--dry-run') {
    $dry_run = 1;
  } else {
    print STDERR "cvs-clean: unknown argument '".$arg."'\n\n".$usage;
    exit (1);
  }
}

&cvsclean ("");
