Re: [Emacs-devel] Emacs move

[Karl Fogel]

Dave Love <address@hidden> writes:
> Sorry, my repository-munging loop didn't DTRT in the top-level
> directory.  It needs
> [...]

You may be interested in the `cvschroot.pl' script from the CVSUtils
suite by Tom Tromey and Pavel Roskin.  The entire suite is available
from:

   http://www.red-bean.com/cvsutils/

But for your convenience, here is cvschroot.pl:

--------------------8-<-------cut-here---------8-<-----------------------
#! /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);
}