#! /usr/local/bin/perl -w
# -*- mode:perl -*-
# $Id: chcvsroot.pl,v 1.8 1999/04/27 20:22:39 user Exp $
# Copyright (c) 2002 auto92089@hushmail.com

use strict;
use integer; # REMOVE IF YOU USE FLOATING POINT!

use File::Basename;
use vars qw($progname);
$main::progname = basename $0;

# use Getopt::Long;
# GetOptions() or die "Usage: $main::progname\n";

my $new_root = $ARGV[0];
shift;
my $new_root_path;
if ($new_root =~ /:?(?:[\da-z][\da-z-]*[\da-z]?(?:\.[\da-z][\da-z-]*[\da-z]?)*):(.*)$/i) {
    $new_root_path = $1;
}
else {
    $new_root_path = $new_root;
}

use File::Find ();

# Traverse desired filesystems

&File::Find::find(\&wanted, scalar(@ARGV) ? @ARGV : '.');

sub wanted {
    /^CVS$/ and -d $_ and &rewriteroot() and $File::Find::prune = 1;
}

use IO::File;

sub rewriteroot {
    my $rootf = new IO::File "CVS/Root", "r+";
    my $reposf = new IO::File "CVS/Repository", "r+";
    if (defined $rootf and defined $reposf) {
	# fix up CVS/Root
	my $oldroot = <$rootf>;
	chomp $oldroot;
	$rootf->seek(0,0);
	$rootf->print("$new_root\n");
	$rootf->truncate(length("$new_root\n"));
	# fix up CVS/Repository
	$oldroot =~ /^:?(?:[\da-z][\da-z-]*[\da-z]?(?:\.[\da-z][\da-z-]*[\da-z]?)*):(.*)$/i and $oldroot = $1;
	my $oldrepos = <$reposf>;
	# note: we keep the trailing newline
	$oldrepos =~ s!$oldroot!$new_root_path!oe;
	$reposf->seek(0,0);
	$reposf->print($oldrepos);
	$reposf->truncate(length($oldrepos));
    }
    defined($rootf) and $rootf->close;
    defined($reposf) and $reposf->close;
}

$main::exitcode = 0;

exit $main::exitcode;