#!/usr/bin/perl

use strict;
use Getopt::Std;
use IO::Dir;
use Tie::File;
use Data::Dumper;
use File::Spec;
use Pod::Usage;

my $rcstree = "$ENV{HOME}/RCS-tree";
my $btinfo = "RCS/bt.info";

sub nub {
    my %saw;
    return (grep (!$saw{$_}++, @_));
}

my %o;
getopts("vuh", \%o) || pod2usage(-verbose => 2, -exitval => 1);

if ($o{h} ) {
    pod2usage(-exitval => 0, -verbose => 2, -output => \*STDOUT);
}

push @ARGV, "info" unless @ARGV;

my %commands = (
    bring  => \&do_bring,
    diff   => \&do_diff,
#    co     => \&do_co,
#    ci     => \&do_ci,
    ls     => \&do_ls,
    update => \&do_update,
    info   => \&do_info,
    avail   => \&do_avail
);

my %controlled_files;
$controlled_files{$_} = 1 foreach (controlled_files());

if($commands{$ARGV[0]}) {
    $commands{$ARGV[0]}->();
} else {
    pod2usage(-message => "Unknown Command: $ARGV[0]", -verbose => 2, -exitval => 1);
}


sub get_all () {
    my $d = new IO::Dir "$rcstree" or die "$rcstree: $!";
    my @a = $d->read();
    my %h;
    foreach (@a) {
        next if /^\./;
        if (s/,v$//) {
            $h{$_} = ["$_,v"];
        } else {
            my $d = new IO::Dir "$rcstree/$_" or die "$rcstree/$_: $!";
            my @c = $d->read();
            my $n = $_;
            @c = grep s/^.*,v$/$n\/$&/, @c;
            $h{$_} = \@c;
        }
    }
    return \%h;
}


sub get_contents () {
    die "invalid RCS directory" unless -d "RCS" && ! -l "RCS" && -f "RCS/bt.info";
    tie my @a, 'Tie::File', "$btinfo" or die "Could not open $btinfo\n";
    my $all = get_all();
    my %h;
    foreach (@a) {
        my @c = map  { s/^(.*\/)//; $_ } @{$all->{$_}};
        $h{$_} = \@c;
    }
    return \%h;
}

sub controlled_files() {
    return () unless -d "RCS" && ! -l "RCS" && -f "RCS/bt.info";
    tie my @a, 'Tie::File', "$btinfo" or return ();
    my $all = get_all();
    my %h;
    foreach (@a) {
        my @c = map  { s/^(.*\/)//; $_ } @{$all->{$_}};
        $h{$_} = \@c;
    }
    my @r;
    foreach ((keys %h)) {
        push(@r,$_),next if (@{$h{$_}}) == 1;  
        foreach (@{$h{$_}}) {
            s/(.*),v/$1/ or die "weird entry $_";
            push(@r,$_);
        }
    } 
    @r
}

sub do_info () {
    my $c = get_contents();
    #print Dumper($c);
    show_tree($c)
}
sub do_avail () {
    my $c = get_all();
    #print Dumper($c);
    show_tree($c)
}

sub sf($) {
    my $r = "";
    $r .= " -" if -f $_[0] || $controlled_files{$_[0]};
    $r .= " exists" if -f $_[0];
    $r .= " controlled" if $controlled_files{$_[0]};
    "$_[0]$r"
}


sub file_names($) {
    my $h = shift;
    my @r;
    foreach ((keys %$h)) {
        push(@r,$_),next if (@{$h->{$_}}) == 1;  
        foreach (@{$h->{$_}}) {
            s/.*\/(.*),v/$1/ or die "weird entry $_";
            push(@r,$_);
        }
    } 
    @r
}

sub show_tree($) {
    my $h = shift;
    foreach (sort (keys %$h)) {
        print( sf($_),"\n"),next if (@{$h->{$_}}) == 1;  
        print( "$_\n"); 
        foreach (sort @{$h->{$_}}) {
            s/(.*\/)?(.*),v/$2/ or die "weird entry $_";
            print "    ",sf($_),"\n";
        }
    } 
}

sub do_bring () {
    #die "invalid RCS directory" unless -d "RCS" && ! -l "RCS" && -f "RCS/bt.info";
    die "RCS is link" if -l "RCS";
    my @w = nub(@ARGV[1..@ARGV - 1]);
    mkdir "RCS";
    my $c = get_all();
    my @d;
    foreach (@w) {
        print "$_ is not known\n",next unless $c->{$_};
        push @d, $_; 
        foreach my $f (@{$c->{$_}}) {
            my $from = File::Spec->abs2rel("$rcstree/$f", "RCS");
            $f =~ s/^(.*\/)//;
            my $to = "RCS/$f";
            if (-l $to && ! -e $to) {
                print "$to is broken, unlinking.\n",  
                unlink $to;
            }
            if (symlink $from, $to) {
                print "linked $from -> $to\n";
            } else {
                next if -l $to && (readlink $to eq $from); 
                print "could not link $from -> $to\n";
            }
        }
    }
    tie my @a, 'Tie::File', "$btinfo" or die "Could not open $btinfo\n";
    my @n = nub(@a,@d);
    @a = @n;
}

sub get_ls () {
    my $c = get_contents();
    my @r;
    foreach (values %$c) { push @r, @$_ }
    map s/,v$//, @r;
    return @r;
}

sub do_ls() {
    my @f = get_ls();
    map { print "$_\n" } @f;
}

sub do_update () {
    die "invalid RCS directory" unless -d "RCS" && ! -l "RCS" && -f "RCS/bt.info";
    my @l = get_ls();
    foreach (@l) {
        system "co -u $_";
    }
}

sub do_diff () {
    die "invalid RCS directory" unless -d "RCS" && ! -l "RCS" && -f "RCS/bt.info";
    my @l = get_ls();
    my $opt = ($o{v} ? "" : "-q")  . " " .  ($o{u} ? "-u" : ""); 
    foreach (@l) {
        print "*** $_\n" if(!$o{v} && !$o{u});
        system "rcsdiff $opt $_";
    }
}


__END__


=head1 NAME

bt - simple wrapper around RCS for sharing files between projects

=head1 SYNOPSIS

bt [options] <command> [projects ... ]

=head1 COMMANDS

=over

=item bring  [projects ...]

create the RCS directory and create the appropriate symbolic links for the listed projects. 

=item diff

show differences between your working versions and the ones in the repository

=item ls

print the file names under repository control

=item update

checkout the latest version of each file. will prompt for files you have modified.

=item info

show information about current directory.

=item avail

list available projects

=cut