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