#! /usr/bin/perl -w

# This script binds the working directory to the given CVS root by
# storing the new value is the CVS/Root files
# If CVS/Repository contains the full path, it is adjusted to match
# the new root
# The environment variable CVSROOT overrides the contents of CVS/Root

use strict;

Main();

sub Main
{
	if (!$ARGV[0] || ($ARGV[0] eq '--help') || ($#ARGV > 0))
	{
		usage ();
	}

	my $root = $ARGV[0];
	my $cvspath = split_root($root, "New CVS Root");
	my $old_root = $ENV{"CVSROOT"};
	my $fixed_root = defined ($old_root);

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

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

		unless ($fixed_root) {
			$old_root = get_line($dir . "Root");
		}

		my $old_cvspath = split_root($old_root, "Old CVS Root");

		my $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;
}

# print usage information and exit
sub usage
{
	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;
}


# 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 ($_ = <FILE>) {
		chomp;
	} else {
		error ("couldn't read $file\n");
	}
	close (FILE);
	return $_;
}

# 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);
}