#!/usr/local/bin/perl -w

use strict;
use Getopt::Std;

########################
### MAIN
########################

print intro();

my %opts;
getopts("rfnvd:m:", \%opts);
$opts{$_} = exists($opts{$_}) for qw(r f n v);

my $pwd = `pwd`; chomp($pwd);
exit unless ($opts{f} || user_prompt("Add working directory '$pwd' to 
+existing CVS repository? (y/n): ", "[yY]"));

# set CVSROOT
if (exists $opts{d}) {
    $ENV{CVSROOT} = $opts{d};
    print "CVSROOT set to '$ENV{CVSROOT}'\n";

} elsif (!(exists $ENV{CVSROOT} && length($ENV{CVSROOT}))) {
    $ENV{CVSROOT} = user_ask("\nEnvironment variable CVSROOT is not se
+t! What should I set it to?\n CVSROOT: ");
    check_cvsroot();

} else {
    print "Will use existing CVSROOT '" . $ENV{CVSROOT} ."'\n";
    $ENV{CVSROOT} = user_ask("\nNew CVSROOT: ") unless ($opts{f} || us
+er_prompt("Confirm if you are OK with it? (y/n): ", "[yY]"));
    check_cvsroot();
}

my $cvs_repository = (exists $opts{m}) ? $opts{m} :
    user_ask("\nRepository module name for the working directory: ");
my $cvs_dir = "$pwd/CVS";

# check top CVS directory to ensure that user doesn't re-initialize
# a working directory that may already belong to a cvs repository.
if (!$opts{f} && -d $cvs_dir) {
    print "\nDirectory '$cvs_dir' already exists!\n"
         ."Which implies that this working directory may already belon
+g to an existing cvs repository.";
    exit unless user_prompt("\nProceed anyway? (will replace the conte
+nts of '$cvs_dir' cvs directory): ", "[yY]");
}

eval {
    print "Initializing...\n";
    my @modules = ("");

    if ($opts{r}) {
        # will have to create a CVS directory in each sub
        # directory (similar to what a cvs -import would do)
        print "[retreaving sub directories:\n";
        push @modules, @{get_child_modules($pwd, "CVS")};
        print "]\n\n";
    }

    cvs_init_module({
        cvs_root => $ENV{CVSROOT},
        repository => $cvs_repository,
        working_root => $pwd,
        modules => \@modules,
        safe    => $opts{n},
        verbose => $opts{v}
        });

    print "\nCompleted successfully!\n";
};
if ($@) {
    print "\nFAILED: $@\n";
    exit(0);
}

exit;

########################
### SUBS
########################

sub check_cvsroot {
    unless (-d $ENV{CVSROOT}) {
        print "Directory " . $ENV{CVSROOT} . " doesn't exist!\n";
        exit;
    }
}

sub user_ask {
    print $_[0];
    my $answer = <STDIN>; chomp($answer);
    return $answer;
}

sub user_prompt {
    my $answer = user_ask($_[0]);
    return ($answer =~ m/$_[1]/);
}

#---------------------------------------------------------------------
# mkdir_rec($dir, $mode, $safe)
#
# safe = 1 - return appropriate numerical code instead of a die.
#        0 - die. (default)
#
sub mkdir_rec {
    my ($dir, $mode, $safe) = @_;
    return 0 unless ($dir);               # $dir required.
    return 1 if (-d $dir);                # return if already exists

    my $mode_o = ($mode)?"-m $mode":"";

    # execute shell comand: use -p to create directories recursively
    # back tick command should return 0 on failure.
    system("mkdir -p $dir $mode_o") == 0
        or ($safe ? return 0 : die "Failed to create '$dir'.");

    return 1;
}

sub touch {
    my $now = time;
    local (*TMP);
    foreach my $file (@_) {
        utime ($now, $now, $file)
            || open (TMP, ">>$file")
            || die ("Couldn't touch file: $!\n");
    }
}

sub get_child_modules {
    my ($start_path, $skip_match) = @_;

    # i'm not particularly happy with this since diagnostic
    # output of system call enclosed in `` will end up in
    # STDOUT
    my @dirs = grep !/^$|$skip_match/, map {s/^\.[\/]*//; chomp; "$_";
+} (`cd $start_path; find . -type d`);
    return \@dirs;
}
sub cvs_init_module {
    my $hargs = $_[0];
    return unless (exists $$hargs{cvs_root} &&
                   exists $$hargs{working_root});

    my $verbose = $$hargs{verbose} || 0;
    my @modules = @{$$hargs{modules}};
    my $cvs_root = $$hargs{cvs_root};
    my $working_root = $$hargs{working_root};
    my $repository = $$hargs{repository};
    my $safe = $$hargs{safe};

    my ($cvs_module, $cvs_dir);

    print "\tREPOSITORY -> WORKING DIRECTORY\n" if ($verbose);

    my %failed_modules;

    for (@modules) {
        my $cvs_module = "$cvs_root/$repository/$_";
        clean_path($cvs_module);

        my $cvs_dir = "$working_root/$_/CVS";
        clean_path($cvs_dir);

        print "\t$cvs_module -> $cvs_dir\n" if ($verbose);

        unless ($safe) {
            eval {
                mkdir_rec($cvs_module);
                mkdir_rec($cvs_dir);
            };
            if ($@) {
                $failed_modules{$_} = $@;
                next;
            }

            open(FOUT, ">$cvs_dir/Repository") or die "can't open '$cv
+s_dir/Repository'";
            print FOUT "$repository";
            close(FOUT);

            open(FOUT, ">$cvs_dir/Root") or die "can't open '$cvs_dir/
+Root'";
            print FOUT $ENV{CVSROOT};
            close(FOUT);

            touch("$cvs_dir/Entries");
        }
    }

    if ($verbose) {
        print "\nFAILED ON:\n\tDIRECTORY ->\tREASON:\n";
        print "\t$_ ->\t". $failed_modules{$_} ."\n" foreach (keys %fa
+iled_modules);
    }
}

# clean a directory path of extraneous '/'
sub clean_path {
    for (my $i = 0; $i <= $#_; $i++) {
    # match two or more '/' between a pair of
    # other non '/' chars and replace the
    # multiple occurance of '/' with a single '/'.
        $_[$i] =~ s|([^/])[/]{2,}([^/])|$1/$2|g;
    # remove trailing garbage such as '/'...
    $_[$i] =~ s|[/\n\t\s]+$||
    }
}
sub intro {
    return <DATA>;
}

__DATA__

#---------------------------------------------------------------------
+---------
# CVSINIT Utility
#
# Associates your current directory with an existing CVS
# repository.
#
# USAGE: cvsinit [-rfmv] [-d [cvs root]]
#                        [-m [new cvs module name for current working 
+directory]]
#
#
# OPTIONS:
#    -r  =  initialize recursively
#           (will create a CVS directory in each of the given
#            working directory's sub directories)
#
#    -f  =  don't prompt excessively
#
#    -n  =  do not execute anything that will change the disk.
#
#    -v  =  verbose
#
# comments?
# contact: Vladimir Bogdanov (b_vlad@telus.net, Perl Monk ID: vladb)
#---------------------------------------------------------------------
+---------
[download]