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

use strict;
use Getopt::Std;
use File::Find;

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

print intro();

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

exit if ($opts{h});

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 belong t
+o an existing cvs repository.";
    exit unless user_prompt("\nProceed anyway? (will replace the conte
+nts of '$cvs_dir' cvs directory) (y/n): ", "[yY]");    
}

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

    if ($opts{r}) {
    my %failed_modules;

    # will have to operate on each sub directory 
    # (similar to what a 'cvs import' would do)
    @modules = @{get_child_modules({        
        dir  => $pwd,
        skip => "CVS",
        exceptions => \%failed_modules
    })};
    
    if ($opts{v}) {
        print "SKIPPED DIRECTORIES\n";
        foreach (keys %failed_modules) {
        print "\tDIRECTORY: $_\n"
             ."\tREASON:    ". $failed_modules{$_} ."\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 wanted {    
#    print "DIR: $_\n"; 
#    if (-d $_) { print "true\n"; }
    print "here\n";
}

sub get_child_modules {
    my ($startdir, $skip_match, $exceptions) = @{$_[0]}{qw(dir skip ex
+ceptions)};
    my $startdir_len = length($startdir);    
    my (@dirs);
    
    # I rewrite sigwarn to 'log' every directory/file that 
    # causes find() to flag a warning.
    if (ref $exceptions eq "HASH") {
    $SIG{__WARN__} = sub { 
        $$exceptions{substr($File::Find::name, $startdir_len)} = $_[0]
+; 
        splice(@dirs, -1);
    };

    } else {
    # still avoid dumping warnings even 
    # if this sub is not asked to return exceptions.
    $SIG{__WARN__} = sub {};
    }
    
    find(sub { !/$skip_match/ && -d && push @dirs, substr($File::Find:
+:name, $startdir_len); }, $startdir);

    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, $working_root, $repository, $safe) = 
    @{$hargs}{qw(cvs_root working_root repository safe)};

    my ($cvs_module, $cvs_dir);
    
    print "IMPORTING\n"
     ."\tREPOSITORY -> WORKING DIRECTORY\n" if ($verbose);

    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) {
        mkdir_rec($cvs_module);
        mkdir_rec($cvs_dir);
    
        open(FOUT, ">$cvs_dir/Repository") or die "can't open '$cvs_di
+r/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");    
    }    
    }
}

# 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)
#---------------------------------------------------------------------
+---------