#! /usr/bin/perl
#
#	$Id$
#
#	Recommended aliases:
#		alias cvsfiles='cvsutil --files --print'
#		alias cvsignores='cvsutil --ignores --print'
#		alias cvsignoresall='cvsutil --ignores --workings --print'
#		alias cvsignoresrm='cvsutil --ignores --rm'
#		alias cvsignoresrmall='cvsutil --ignores --workings --rm'
#		alias cvsignoresallrm='cvsutil --ignores --workings --rm'

use strict;
use warnings;

use Getopt::Long;
use Cwd qw(chdir fastgetcwd);
use Errno qw(ENOENT);
use Carp qw(confess cluck croak carp);
BEGIN {
	if (!eval q{ use File::Remove qw(remove); 1; }) {{
		sub main::remove(@)
		{
			my $r="";
			if ("SCALAR" eq ref $_[0]) {
				$r="-r" if ${$_[0]};
				shift;
				}
			my $cmd="rm -f $r ".join(" ",map({s/'/'\\''/g;"'$_'";} @_));
			my $err=system($cmd) and confess("$cmd: $cmd");
			return @_;
		}
		}}
}

use constant ENTRIES  =>"CVS/Entries";
use constant CVSIGNORE=>".cvsignore";
use constant ROOT     =>"CVS/Root";

my($opt_files,$opt_ignores,$opt_workings,$opt_dirs);
my($opt_rm,$opt_print);
our($opt_root); # undefined=>no rooting, ""=>print roots or first phase for root checking, ne ""=>set roots
my($opt_verbose,$opt_fatal);
my($opt_force); # set roots without their checking
my(@opt_ignore);

$Getopt::Long::ignorecase=0;
$Getopt::Long::bundling=1;
die if !GetOptions_shortfilter(
		"f|files!"   ,\$opt_files,
		"i|ignores!" ,\$opt_ignores,
		"w|workings!",\$opt_workings,
		"d|dirs!"    ,\$opt_dirs,
		"r|rm!"      ,\$opt_rm,
		"p|print!"   ,\$opt_print,
		  "root:s"   ,\$opt_root,
		"v|verbose!" ,\$opt_verbose,
		  "fatal!"   ,\$opt_fatal,
		  "force!"   ,\$opt_force,
		"I|ignore=s" ,\@opt_ignore,
		);

die "--root possible only with (optional and ignored) -d|--dirs"
		if defined $opt_root && ($opt_files || $opt_ignores || $opt_workings || $opt_dirs || $opt_rm || $opt_print);
die "-d|--dirs forbidden with -r|--rm"
		if $opt_dirs && $opt_rm;
die "Nothing to do (no -r|--rm, no -p|--print)"
		if !$opt_rm && !$opt_print && !defined $opt_root;
die "Nothing to process (no -f|--files, no -i|--ignores, no -w|--workings, no -d|--dirs)"
		if !defined $opt_root && (!$opt_files && !$opt_ignores && !$opt_workings && !$opt_dirs);

my @all_ignore=("CVS");
for (@opt_ignore) {
	push @all_ignore,$_;
	@all_ignore=() if $_ eq "!";
	}

my($root_contents,@root_dirs);

@ARGV=(".") if !@ARGV;
our(@dir_dirs)=@ARGV;
our(@dir_files,@dir_ignores,@dir_workings,@dir_victims);
our($dir_dirname)="";
unless ((defined $opt_root && $opt_root ne "") && $opt_force) {
	local($opt_root)=$opt_root;
	$opt_root="" if defined $opt_root && $opt_root ne "";
	localdircore();
	}

actionrootfinal() if defined $opt_root && $opt_root eq "";
if (defined $opt_root && $opt_root ne "") {
	die "Non-matching \"".ROOT."\" contents, use --force for override" if !@root_dirs && !$opt_force;
	localdircore();
	}

exit 0;

sub mayfatal
{
my($msg,%opts)=@_;

	my $errstr=$!;
	$msg.=" in \"".fastgetcwd."\" (CVS \"$dir_dirname\")".($opts{"noerrno"} ? "" : ": $errstr");
	croak $msg if $opt_fatal;
	carp $msg;
}

sub fordirs
{
my($func,@dirs)=@_;

	my $origdir=fastgetcwd;
	for (@dirs) {
		if (!chdir $_) {
			mayfatal "Unable to process directory \"$_\"";
			next;
			}
		&$func($_);
		chdir $origdir;
		}
}

sub localdir
{
my($localdirname)=@_;

	verbose("localdir(\"$localdirname\") entry");

	local(@dir_dirs,@dir_files,@dir_ignores,@dir_workings,@dir_victims);
	local($dir_dirname)=$dir_dirname.$localdirname."/";

	localreaddir() or return;

	localdircore();

	verbose("localdir(\"$localdirname\") exit");
}

sub localdircore
{
	localvictims() if !defined $opt_root;
	localaction();

	fordirs \&localdir,@dir_dirs;
}

sub filterout
{
my($from,@what)=@_;

	my %hash=map { $_=>1; } @$from;
	for (@what) {
		delete $hash{$_};
		}
	return keys %hash;
}

sub localreaddir
{
	local *E;
	if (!open E,ENTRIES) {
		mayfatal "File \"".ENTRIES."\" cannot be opened";
		return 0;
		}
	while (<E>) {
		chomp;
		next if /^D$/;
		do { push @dir_dirs ,$1; next; } if m#^D/([^/]*)/#;
		next if m#^/[^/]*/-#;	# deleted file: /filename/-1.1/dummy timestamp//
		# New file is a valid entry!
		# next if m#^/[^/]*/0/#;	# new file: /filename/0/dummy timestamp//
		do { push @dir_files,$1; next; } if m#^/([^/]*)/# ;
		mayfatal "File ".ENTRIES." contains invalid line \"$_\"",("noerrno"=>1);
		}
	close E;

	return 1 if defined $opt_root;

	local *I;
	if (open I,CVSIGNORE) {
		while (<I>) {
			while (/\S+/g) {
				for (<$&>) {
					push @dir_ignores,$_ if -e $_;
					}
				}
			}
		close I;
		@dir_ignores=filterout \@dir_ignores,@dir_dirs,@dir_files;
		}
	else {
		mayfatal "File \"".CVSIGNORE."\" cannot be opened" if !$!{ENOENT};
		}

	local *D;
	if (!opendir D,".") {
		mayfatal "Cannot read directory \".\"";
		return 0;
		}
	@dir_workings=filterout [readdir D],@dir_dirs,@dir_files,@dir_ignores,@all_ignore,".","..";
	closedir D;
	return 1;
}

sub localvictims
{
	push @dir_victims,@dir_files    if $opt_files;
	push @dir_victims,@dir_ignores  if $opt_ignores;
	push @dir_victims,@dir_workings if $opt_workings;
	push @dir_victims,@dir_dirs     if $opt_dirs;
}

sub localactionprint
{
my($filename)=@_;

	mayfatal "File \"$filename\" does not exist",("noerrno"=>1) if !-e $filename;
	print "${dir_dirname}$filename\n";
}

sub localactionrm
{
my($filename)=@_;

	# &chmod follows the symlinks.
	-l $filename or chmod 0700,$filename or do {
		mayfatal "File \"$_\" cannot be chmod(2)ed" if !$!{ENOENT};
		};
	# '\1' for '-r':
	remove \1,$filename or do {
		mayfatal "File \"$_\" cannot be removed" if !$!{ENOENT};
		};
}

sub localactionrootset
{
	local *R;
	if (!open R,'+<',ROOT) {
		mayfatal "File \"".ROOT."\" cannot be written";
		return;
		}
	print R "$opt_root\n";
	truncate R,tell R;
	close R;
}

sub localactionrootprint
{
	local *R;
	if (!open R,ROOT) {
		mayfatal "File \"".ROOT."\" cannot be opened";
		return;
		}
	local $/=undef;
	localactionrootprintcheck(<R>);
	close R;
}

sub localactionrootprintcheck
{
my($contents)=@_;

	if (!defined $root_contents) {
		push @root_dirs,$dir_dirname;
		$root_contents=$contents;
		return;
		}
	if (@root_dirs && $root_contents eq $contents) {
		push @root_dirs,$dir_dirname;
		return;
		}
	if (@root_dirs) {
		print map "$_: $root_contents",@root_dirs;
		@root_dirs=();
		}
	print "$dir_dirname: $contents";
}

sub actionrootfinal
{
	return if !@root_dirs;
	print $root_contents;
}

sub localaction
{
	if ("" ne $dir_dirname && defined $opt_root) {
		localactionrootset()   if defined $opt_root && "" ne $opt_root;
		localactionrootprint() if defined $opt_root && "" eq $opt_root;
		return;
		}
	for (@dir_victims) {
		localactionprint $_ if $opt_print;
		localactionrm    $_ if $opt_rm;
		}
}

sub verbose
{
my($msg)=@_;

	return if !$opt_verbose;
	print fastgetcwd.": $msg\n";
}

sub GetOptions_shortfilter
{
	my @r;
	while ($_=shift) {
		if (/^(\w)\|/) {
			my $ref=shift;
			push @r,$1,$ref,$',$ref;
			next;
			}
		push @r,$_;
		}
	return GetOptions @r;
}