#! /usr/bin/perl -w
# This script changes CVS/Root contents to the given value
# Quite trivial to do without cvsu, but just in case

if (!$ARGV[0] || ($ARGV[0] eq '--help') || ($#ARGV > 0))
{
	print "Usage: cvschroot ROOT\n" .
	"ROOT is the CVS Root to be written to CVS/Root\n" .
	"CVS/Repository is also modified if necessary\n";
	exit 1;
}

$root = $ARGV[0];
$cvspath = split_root($root, "New CVS Root");

open(CVSADM, "cvsu --ignore --find --types C |") ||
	error ("Cannot read output of cvsu\n");

while (<CVSADM>) {
	chomp;
	$dir = $_;
	unless ( $dir =~ m{/$} ) {
		$dir .= "/";
	}
	if ($dir =~ "^\./(.*)") {
		$dir = $1;
	}

	$old_root = get_line($dir . "Root");
	$old_cvspath = split_root($old_root, "Old CVS Root");

	$repo = get_line($dir . "Repository");

	# if $repo is relative path, leave it as is
	if ( $repo =~ m{^/} ) {
		unless ( $repo =~ s{^$old_cvspath}{$cvspath} ) {
			error ("${dir}Repository doesn't match ${dir}Root\n");
		}

		put_line ($dir . "Repository", $repo);
	}
	put_line ($dir . "Root", $root);
}

# print message and exit (like "die", but without raising an exception)
sub error
{
    print STDERR shift(@_);
    exit 1;
}

# Split CVSROOT into path and everything before it
sub split_root
{
	my $res;
	if ( shift(@_) =~ m{^(:[^ ]+:)?(/[^:@ ]+)$} ) {
		$res = $2;
	} else {
		error shift(@_) . " not recognized\n";
	}
	return $res;
}

# Read one line from file
sub get_line
{
	my $file = shift(@_);
	open (FILE, "< $file")
		|| error ("couldn't open $file\n");
	if ($line = <FILE>) {
		chomp $line;
	} else {
		error ("couldn't read $file\n");
	}
	close (FILE);
	return $line;
}

# Write one line to file
sub put_line
{
	my $file = shift(@_);
	open (FILE, "> $file")
		|| error ("couldn't write to $file\n");
	print FILE shift(@_) . "\n";
	close (FILE);
}
