in reply to Fake CVS import with Perl.
#!/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) #--------------------------------------------------------------------- +---------
|
|---|