/usr/bin/cvschroot is in cvsutils 0.2.5-1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | #! /usr/bin/perl -w
# cvschroot - change CVS Root of CVS working directory to given value
# Copyright (C) 2000-2005 Pavel Roskin <proski@gnu.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
require 5.004;
use strict;
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");
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");
}
put_line ($dir . "Repository", $repo);
}
put_line ($dir . "Root", $root);
}
}
# Print message and exit (like "die", but without raising an exception).
# Newline is added at the end.
sub error ($)
{
print STDERR "cvschroot: ERROR: " . shift(@_) . "\n";
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{^([^ ]+:([0-9]+)?)?(/[^:@ ]+)$} ) {
$res = $3;
} else {
error shift(@_) . " not recognized";
}
return $res;
}
# Read one line from file.
sub get_line ($)
{
my $file = shift(@_);
open (FILE, "< $file")
|| error ("Couldn't open $file for reading: $!");
if ($_ = <FILE>) {
chomp;
} else {
error ("Couldn't read $file");
}
close (FILE);
return $_;
}
# Write one line to file.
sub put_line ($)
{
my $file = shift(@_);
open (FILE, "> $file")
|| error ("Couldn't open $file for writing: $!");
print FILE shift(@_) . "\n";
close (FILE);
}
Main();
|