#!/usr/local/bin/perl -w
#  File id
#
#       .Copyright (C)  2001 Vladimir Bogdanov
#       .Created:       2001-12
#       .Contactid:     <b_vlad@telus.net>
#       .Keywords:      cvs perl import utility
#       .Url:           
#
#       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 of
#       the License, 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., 675 Mass Ave, Cambridge, MA 02139, USA.
#

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

my $VERSION = 1.0;

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

print intro();

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

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 set! 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} || user_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 to an existing cvs repository.";
    exit unless user_prompt("\nProceed anyway? (will replace the contents 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},
		  cvs_add => $opts{a},
		  cvs_text => $opts{t} || "added with cvsinit",
		  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 ($startdir, $skip_match, $exceptions) = @{$_[0]}{qw(dir skip exceptions)};
    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, $cvs_add, $cvs_text) = 
		  @{$hargs}{qw(cvs_root working_root repository safe cvs_add cvs_text)};
	 
    my ($cvs_module, $cvs_dir);
    
    print "IMPORTING\n"
		  ."\tREPOSITORY -> WORKING DIRECTORY\n" if ($verbose);
	 
    for (@modules) {
		  my $repository_module = "$repository/$_";
		  clean_path($repository_module);		
		  my $cvs_module = "$cvs_root/$repository_module";    
		  clean_path($cvs_module);		
		  
		  my $working_path = "$working_root/$_";
		  clean_path($working_path);
		  my $cvs_dir = "$working_path/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_dir/Repository'";
				print FOUT "$repository_module";
				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 ($cvs_add) {
					 eval {
						  $DB::single = 1;
						  # cvs would always return 'fail'...?
						  system("cd $working_path; cvs add *; cvs commit -m '$cvs_text'");
						  
					 };

# 						  if ($@) {
# 								# it's pretty lame to throw a 
# 								# die only to be checked in the
# 								# next line, however, i left it this
# 								# way for future expension..
# 								# for now i'm handling the die here,
# 								# later, it might be handled outside of this sub.
# 								print "\tCVS: $@\n";
# 						  }
						  
					 } 
				
		  } # unless ($safe)
		  
    } # for (@modules)
	 
} # sub cvs_init_module

# 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 qq~
#------------------------------------------------------------------------------
# CVSINIT Utility
# 
# Associates your current directory with an existing CVS 
# repository.  
#
# USAGE: cvsinit [-rfmv] [-d [cvs root]]
#                        [-t [a brief message for each file added to the CVS]]
#    
#
# OPTIONS: 
#    -r  =  initialize recursively
#           (will create a CVS directory in each of the given
#            working directory's sub directories)
#
#    -a  =  do 'cvs add' on each file
#
#    -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)
#------------------------------------------------------------------------------
~;
}

=head1 NAME

CvsInit - script to import a working directory into an existing CVS repository.

=head1 DESCRIPTION

CvsInit allows importing a working directory into an existing CVS repository much
like conventional 'cvs import' command works.  However, this particular utility
is flexible enough to perform only certain phases of an import job as requested
via command prompt options.  Many a times, that's exactly what one would require
to start archiving versions of his/her working files.  This script is also
simpler to use in that it doesn't require altering your working directory significantly
(that is, no files will be lost from the working directory that are ment to be excluded
from the repository -- refer to CVS documentation and that on cvsignore in particular)
to perform the task.  In fact, after running this script, you may safely execute
any CVS command not having to worry about making an initial checkout etc (as would
be required with 'cvs import').

=head1 README

n/a

=head1 PREREQUISITES

This script requires the C<strict> module.  It also requires
C<Getopt::Std> and C<File::Find>.

=head1 COREQUISITES

n/a

=cut

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

CPAN/Administrative

=cut