#!/sw/bin/perl
##
##  sCVS -- Switch CVS Repository
##  Copyright (c) 1997 Ralf S. Engelschall, All Rights Reserved. 
##

require 5.004;

use Term::Cap;
use File::PathConvert;
use IO::File 1.06;
use Cwd;


##
##  1. Determine terminal capabilities
##

$term = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };
$bold = $term->Tputs('md', 1, undef);
$norm = $term->Tputs('me', 1, undef);


##   
##   2. Find .scvsrc files and read contents into %CVSROOTS hash
##

%CVSROOTS = ();

#   determine canonical path
sub canonical_path {
    my ($path) = @_;
    my ($pathL);

    $pathL = '';
    while ($path ne $pathL) {
        $pathL = $path;
        $path =~ s|//|/|g;
        $path =~ s|/\./|/|g;
        $path =~ s|/\.$|/|g;
        $path =~ s|^./||g;
        $path =~ s|([^/.][^/.]*)/\.\.||;
    }
    return $path;
}

#   create list of dirs back to root
($cwd = Cwd::cwd) =~ s|/$||;
$cwdT = $cwd;
while ($cwdT) {
    push(@DIR, $cwdT);
    $cwdT =~ s|/[^/]+$||;
}

#   search for .scvsrc files
foreach $dir (reverse(@DIR)) {
    if (-f "$dir/.scvsrc") {
        $reldir = &canonical_path(File::PathConvert::abs2rel($dir));
        $subdir = &canonical_path(File::PathConvert::abs2rel($cwd, $dir));
        $rcfile = &canonical_path("$reldir/.scvsrc");
        &process_rcfile($rcfile, $cwd, $reldir, $subdir);
    }
}

#   process a particular .scvsrc file
sub process_rcfile {
    my ($rcfile, $cwd, $reldir, $subdir) = @_;
    my ($rc, @E, $e);

    $rc = new IO::File;
    $rc->open("<$rcfile");
    while (<$rc>) {
        next if (m|^\s*#|);
        next if (m|^\s*$|);
        if (m|^\s*(\S+)\s*$|) {
            $CVSROOTS{$1} = '';
        }
        elsif (m|^\s*(\S+)\s+\(\s*(.+?)\s*\)\s*$|) {
            $CVSROOTS{$1} = $2;
        }
        else {
            print STDERR "sCVS:Error: $rcfile, invalid line: `$_'\n";
            exit(1);
        }
    }
    $rc->close();
}


##
##  3. Check for correct location to be called and
##     determine current configured CVS repository location
##

if (not -d "./CVS") {
    print STDERR "sCVS:Error: must stay inside a checked-out CVS tree.\n";
    exit(1);
}

$root = new IO::File;
$root->open("<CVS/Root");
$locC = <$root>;
$locC =~ s|\n$||;
$root->close();


##
##  4. Create iSelect page with list of available CVS repositories
##     and fire up iSelect with it
##

$pos  = 0;
$list = '';
$n    = 1;
foreach $loc (keys(%CVSROOTS)) {
    $name = $CVSROOTS{$loc};
    if ($loc eq $locC) {
        $pos = $n;
        $act = '*';
    }
    else {
        $act = '';
    }
    $list .= ' "'.sprintf("%1s  %-30s  %s<S:%s>", $act, $name, $loc, $loc).'"';
    $n++;
}
if ($pos == 0) {
    $list .= ' "'.sprintf("%1s  %-30s  %s<S:%s>", '*', 'UNKNOWN', $locC, $locC).'"';
    $pos = $n+1;
}
$pos += 3;

$cmd = "iselect -n 'sCVS' -t 'Switch CVS Repository'" .
       " -p$pos -P" .
       " ' '" .
       " 'Available Repositories:'" .
       " ' '" .
       " $list" .
       " ' '" .
       " 'Use CURSOR keys and RETURN to select or \'q\' to quit.'";
$rc = `$cmd`;
($pos, $locN) = ($rc =~ m|^(\d+):(.*)|);

if ($locN eq '') {
    print STDERR "sCVS: Aborted\n";
    exit(1);
}
elsif ($locN eq $locC) {
    print STDERR "Repository unchanged\n";
    exit(0);
}


##
##  5. Time to switch!
##

$prefixN = $locN;
$prefixN =~ s|^[^/]+||;

foreach $dir (split(/\n/, `find . -name CVS -type d -depth -print`)) {
    $dir =~ s|^\./||;
    $dirname = $dir;
    if (length($dirname) > 60) {
        $dirname = '..'.substr($dirname, length($dirname)-60, 60);
    }
    $dirname = sprintf("%-60s", $dirname);
    print STDERR "Processing: ${bold}$dirname$norm\r";

    open(FP, "<$dir/Root");
    $locO = <FP>;
    $locO =~ s|\n$||;
    close(FP);
    open(FP, ">$dir/Root");
    print FP "$locN\n";
    close(FP);
    $prefixO = $locO;
    $prefixO =~ s|^[^/]+||;

    open(FP, "<$dir/Repository");
    $subdir = <FP>;
    $subdir =~ s|\n$||;
    close(FP);
    $subdir =~ s|^$prefixO|$prefixN|;
    open(FP, ">$dir/Repository");
    print FP "$subdir\n";
    close(FP);
}
printf STDERR "%-78s\n", "Repository switched `$locN'";

##EOF##
