#! /bin/perl
# ---------------------------------
# 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, 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.

###########################################################################
# FUNCTION:
# To recursively walk through a PVCS archive directory tree (archives
# located in VCS/ or vcs/ subdirectories) and convert them to RCS archives.
# The RCS archive name is the PVCS workfile name with ",v" appended.
#
# SYNTAX:
# pvcs_to_rcs.pl --help
#
# where -l indicates the operation is to be performed only in the current
# directory (no recursion)
# 
# EXAMPLE:
# pvcs_to_rcs
# Would walk through every VCS or vcs subdir starting at the current directory,
# and produce corresponding RCS archives one level above the VCS or vcs subdir.
# (VCS/../RCS/)
#
# NOTES:
# * This script performs little error checking and logging
#   (i.e. USE AT YOUR OWN RISK)
# * This script was last tested using ActiveState's port of Perl 5.005_02
#   (internalcut #507) under Win95, though it does compile under Perl-5.00404
#   for Solaris 2.4 run on a Solaris 2.6 system.  The script crashed
#   occasionally under ActiveState's port of Perl 5.003_07 but this stopped
#   happening with the update so if you are having problems, try updating Perl.
#   Upgrading to cut #507 also seemed to coincide with a large speed
#   improvement, so try and keep up, hey?  :)  It was executed from MKS's
#   UNIX tools version 6.1 for Win32's sh.  ALWAYS redirect your output to
#   a log!!!
# * PVCS archives are left intact
# * RCS archives are created in VCS/../RCS/ (or ./RCS using '-pflat')
# * Branch labels in this script will be attached to the CVS magic
#   revision number.  For branch a.b.c of a particular file, this means
#   the label will be attached to revision a.b.0.c of the converted
#   file.  If you use the TrunkTip (1.*) label, be aware that it will convert
#   to RCS revision 0.1, which is useless to RCS and CVS.  You'll probably
#   have to delete these.
# * All revisions are saved with correct "metadata" (i.e. check-in date,
#   author, and log message).  Any blank log message is replaced with
#   "no comment".  This is because RCS does not allow non-interactive
#   check in of a new revision without a comment string.
# * Revision numbers are incremented by 1 during the conversion (since
#   RCS does not allow revision 1.0).
# * All converted branch numbers are even (the CVS paradigm)
# * Version labels are assigned to the appropriate (incremented) revision
#   numbers.  PVCS allows spaces and periods in version labels while RCS
#   does not.  A global search and replace converts " " and "." to "_"
#   There may be other cases that ought to be added.
# * Any working (checked-out) copies of PVCS archives
#   within the VCS/../ or vcs/../ (or possibly ./ with '-pflat')
#   will be deleted (or overwritten) depending on your mode of
#   operation since the current ./ is used in the checkout of each revision.
#   I suppose if development continues these files could be redirected to
#   temp space rather than ./ .
# * Locks on PVCS archives should be removed (or the workfiles should be
#   checked-in) prior to conversion, although the script will blaze through
#   the archive nonetheless (But you would lose any checked out revision(s))
# * The -kb option is added to the RCS archive for workfiles with the following
#   extensions: .bin .out .btl .rom .a07 .lib .exe .tco .obj .t8u .c8u .o .lku
#   .a and a few others.  The %bin_ext variable holds these values in regexp
#   form.
# * the --force-binary option can be used to convert binary files which don't
#   have proper extensions, but I'd *probably* edit the %bin_ext variable.
# * This script will abort occasionally with the error "invalid revision
#   number".  This is known to happen when a revision comment has
#   /^\s*Rev/ (Perl regexp notation) in it.  Fix the comment and start over.
#   (The directory locks and existance checking make this a fairly quick
#   process.)
#   Binary files which do not have their mode set properly are likely to look
#   corrupted on initial checkout and use, but using
#   `cvs admin -kb <workfilename>' to retroactively change the RCS keyword
#   substitution mode of the file to binary (and refreshing the files in any
#   local workspaces they are checked out in: `rm <workfilename>; update'
#   should do the trick) should end any problems with the original import.
#   If anyone has checked in changes since the import, those revisions may
#   be corrupted in the imported archive and therefore those changes (commits
#   of corrupted data) may need to be backed out.
# * This script writes lockfiles in the RCS/ directories.  It will also not
#   convert an archive if it finds the RCS Archive existant in the RCS/
#   directory.  This enables the conversion to quickly pick up where it left
#   off after errors or interrupts occur.  If you interrupt the script make
#   sure you delete the last RCS Archive File which was being written.
#   If you recieve the "Invalid revision number" error, then the RCS archive
#   file for that particular PVCS file will not have been created yet.
# * This script will not create lockfiles when processing single
#   filenames passed into the script, for hopefully obvious reasons.
#   (lockfiles lock directories - DRP)
# * Log the output to a file.  That makes it real easy to grep for errors
#   later.  (grep for "^[ \t]*(rcs|ci):" and be aware I might have missed
#   a few cases (get?  vcs?) !!!) *** Also note that this script will
#   exibit some harmless RCS errors.  Namely, it will attempt to lock
#   branches which haven't been created yet. ***
# * I tried to keep the error and warning info up to date, but it seems
#   to mean very little.  This script almost always exits with a warning
#   or an error that didn't seem to cause any harm.  I didn't trace it
#   and our imported source checks out and builds...
#   It is probably happening when trying to convert empty directories
#   or read files (possibly checked out workfiles ) which are not
#   pvcs_archives.
# * You must use the -pflat option when processing single filenames
#   passed as arguments to the script.  This is probably a bug.
# * questions, comments, additions can be sent to info-cvs@nongnu.org
#########################################################################



#
# USER Configurables
#

# %bin_ext should be editable from the command line.
#
# NOTE:  Each possible binary extension is listed as a Perl regexp
#
# The value associated with each regexp key is used to print a log
# message when a binary file is found.
my %bin_ext =
	(
	'\.(?i)abs$' => "Absolute File",
	'\.(?i)bin$' => "Binary",
	'\.(?i)bit$' => "Bit File",
	'\.(?i)ol$' => "Compiler Output",
	'\.(?i)out$' => "Default Compiler Output",
	'\.(?i)ln$' => "Linker Output",
	'\.(?i)lob$' => "Lint Output",
	'\.(?i)zob$' => "DBCO Object",
	'\.(?i)mim$' => "MIME File",
	'\.(?i)dwi$' => "DWI File",
	'\.(?i)iop$' => "IOP File",
	'\.(?i)btl$' => "",
	'\.(?i)rom$' => "ROM File",
	'\.(?i)a07$' => "",
	'\.(?i)lib$' => "DOS/Wintel/Netware Compiler Library",
	'\.(?i)lif$' => "Netware Binary File",
	'\.(?i)(com|exe)$' => "DOS/Wintel Executable",
	'\.(?i)tco$' => "",
	'\.(?i)obj$' => "DOS/Wintel Compiler Object",
	'\.(?i)res$' => "DOS/Wintel Resource File",
	'\.(?i)ico$' => "DOS/Wintel Icon File",
	'\.(?i)nlm$' => "Netware Loadable Module",
	'\.(?i)t8u$' => "",
	'\.(?i)c8u$' => "",
	'\.(?i)lku$' => "",
	'\.(?i)pdf$' => "Adobe Acrobat Portable Document Format",
	'\.(?i)doc$' => "MS Word Document",
	'\.(?i)dot$' => "MS Word Document Template",
	'\.(?i)pps$' => "MS PowerPoint Presentation",
	'\.(?i)xls$' => "MS Excel Spreadsheet",
	'\.(?i)(bmp|gif|jfif|jpeg|jpg|png|tif|tiff|xbm)$' => "Image",
	'\.(?i)(bz2|gz|tgz|zip)$' => "Compressed File",
	'\.(?i)dll$' => "DOS/Wintel Dynamically Linked Library",
	'\.(?i)class$' => "Compliled Java Class File",
	'\.(?i)jar$' => "Java Archive File",
	'\.(?i)war$' => "Java Web Archive File",
	'\.o$' => "UNIX Compiler Object",
	'\.a$' => "UNIX Compiler Library",
	'\.so(\.\d+\.\d+)?$' => "UNIX Shared Library"
	);

# The binaries this script is dependant on:
my @bin_dependancies = ("vcs", "vlog", "rcs", "ci");

# Where we should put temporary files
my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/var/tmp";

# We use these...
use strict;

use Cwd;
use File::Basename;			# For the usage message.
use File::Copy;
use File::Path;
use IO::File;
use Getopt::Long;
	$Getopt::Long::bundling = 1;

my $program = basename $0;
my $usage = "\
usage:  $program -h
        $program [-lt] [-i vcsid] [-r flat|leaf] [-p flat|leaf]
                 [-x rcs_extension] [-v none|locks|exists] [options] [path...]
";

my $help = "\
$usage
     ----------------------------           -----------------------------------
     -h | --Help                            Print this text

     General Settings
     ----------------------------           -----------------------------------
     --Recurse                              Recurse through directories
                                            (default)
     -l | --NORecurse                       Process only .
     --Errorfiles                           Save a count of conversion errors
                                            in the RCS archive directory
                                            (default) (unimplemented)
     --NOErrorfiles                         Don't save a count of conversion
                                            errors (unimplemented)
     ( -m | --Mode ) Convert                Convert PVCS files to RCS files
                                            (default)
     ( -m | --Mode ) Verify                 Perform verification ONLY
                                            (unimplemented)
     ( -v | --VERIfy ) None                 Always replace existing RCS files
     ( -v | --VERIfy ) LOCKS                Same as exists unless a #conv.done
                                            file exists in the RCS directory.
                                            In that case, only the #conv.done
                                            file's existance is verified for
                                            that directory.  (default)
     ( -v | --VERIfy ) Exists               Don't replace existing RCS files
     ( -v | --VERIfy ) LOCKDates            Verify that an existing RCS file's
                                            last modification date is older
                                            than that of the lockfile
                                            (unimplemented)
     ( -v | --VERIfy ) Revs                 Verify that the PVCS archive files
                                            and RCS archive file contain the
                                            same number of corresponding
                                            revisions.  Add only new revisions
                                            to the RCS file.  (unimplemented)
     ( -v | --VERIfy ) Full                 Perform --verify=Revs and confirm
                                            that the text of the revisions is
                                            identical.  Add only new revisions
                                            unless an error is found.  Then
                                            erase the RCS archive and recreate
                                            it.  (unimplemented)
     -t | --Test-binaries                   Use 'which' to check \$PATH for
                                            the binaries required by this
                                            script (default)
     --NOTest-binaries                      Don't check for binaries
     --VERBose                              Enable verbose output
     --NOVerbose                            Disable verbose output (default)
     -w | --Warnings                        Print warning messages (default)
     --NOWarnings                           Don't print warning messages

     RCS Settings
     ----------------------------           -----------------------------------
     ( -r | --RCS-Dirs ) leaf               RCS files stored in ./RCS (default)
     ( -r | --RCS-Dirs ) flat               RCS files stored in .
                                            (unimplemented)
     ( -x | --RCS-Extension )               Set RCS file extension
                                            (default = ',v')
     --Force-binary                         Pass '-kb' to 'rcs -i' regardless
                                            of the file extension
     --NOForce-binary                       Only use '-kb' when the file has
                                            a binary extension (default)
     --CVS-Branch-labels                    Use CVS magic branch revision
                                            numbers when attaching branch
                                            labels (default)
     --NOCvs-branch-labels                  Attach branch labels to RCS branch
                                            revision numbers (unimplemented)

     CVS Settings
     ----------------------------           -----------------------------------
     ( -d | --CVS-Module-path)              Import RCS files directly into this
                                            destination directory rather than
                                            converting in place

     PVCS Settings
     ----------------------------           -----------------------------------
     ( -p | --Pvcs-dirs ) leaf              PVCS files expected in ./VCS
                                            (default)
     ( -p | --Pvcs-dirs ) flat              PVCS files expected in .
     ( -i | --VCsid ) vcsid                 Use vcsid instead of \$VCSID

     --------------------------------------------------------------------------
     The optional path argument should contain the name of a file or directory
     to convert.  If not given, it will default to '.'.
     --------------------------------------------------------------------------
";



#
# Initialize globals
#

my ($errors, $warnings) = (0, 0);
my ($curlevel, $maxlevel);
my ($rcs_base_command, $ci_base_command);
my ($donefile_name, $errorfile_name);
my @rel_dirs = ();	# list of relative directory names up to current dir


# set up the default options
my %options = (
	'recurse' => 1,
	'mode' => "convert",
	'errorfiles' => 1,
	'rcs-dirs' => "leaf",
	'rcs-extension' => ",v",
	'force-binary' => 0,
	'cvs-branch-labels' => 1,
	'cvs-module-path' => undef,
	'pvcs-dirs' => "leaf",
	'verify' => "locks",
	'test-binaries' => 1,
	'vcsid' => $ENV{VCSID} || "",
	'verbose' => 0,
	'debug' => 0,
	'warnings' => 1
	);



# This is untested except under Solaris 2.4 or 2.6 and
# may not be portable
#
# I think the readline lib or some such has an interface
# which may enable this now.  The perl installer sure looks
# like it's testing this kind of thing, anyhow.
sub hit_any_key
	{
	STDOUT->autoflush;
	system "stty", "-icanon", "min", "1";

	print "Hit any key to continue...";
	getc;

	system "stty", "icanon", "min", "0";
	STDOUT->autoflush (0);

	print "\nI always wondered where that key was...\n";
	}



# print the usage
sub print_usage
	{
	my $fh = shift;
	unless (ref $fh)
		{
		my $fdn = $fh ? $fh : "STDERR";
		$fh = new IO::File;
		$fh->fdopen ($fdn, "w");
		}

	$fh->print ($usage);
	}

# print the help
sub print_help
	{
	my $fh = shift;
	unless (ref $fh)
		{
		my $fdn = $fh ? $fh : "STDOUT";
		$fh = new IO::File;
		$fh->fdopen ($fdn, "w");
		}

	$fh->print ($help);
	}

# print the help and exit $_[0] || 0
sub exit_help
	{
	print_help;
	exit shift || 0;
	}

sub error_count
	{
	my $type = shift
		or die "$0:  error - error_count usage:  error_count type [, ref] [, LIST]\n";
	my $error_count_ref;
	my $outstring;

	if (ref ($_[0]) && ref ($_[0]) == "SCALAR")
		{
		$error_count_ref = shift;
		}
	else
		{
		$error_count_ref = \$errors;
		}
	$$error_count_ref++;

	push @_, "something wrong.\n" unless ( @_ > 0 );

	$outstring = sprintf "$0:  $type - " . join ("", @_);
	$outstring .= sprintf " - $!\n" unless ($outstring =~ /\n$/);

	print STDERR $outstring;

	if ($options{errorfiles})
		{
		my $fh = new IO::File ">>$errorfile_name" or new IO::File ">$errorfile_name";
		if ($fh)
			{
			$fh->print ($$error_count_ref . "\n");
			$fh->print ($outstring);
			$fh->close;
			}
		else
			{
			my $cd = cwd;
			print STDERR "$0: error - failed to open errorfile $cd/$errorfile_name - $!\n"
					if ($options{debug});
			}
		}

	return $$error_count_ref;
	}



# the main procedure that is run once in each directory
sub execdir
	{
	my $dir = shift;
	my ($errors, $warnings) = (0, 0);					# We return these error counters
	my $old_dir = cwd;

	local ($_, @_);

	my $i;									# Generic counter
	my ($pvcsarchive, $workfile, $rcsarchive);				# .??v, checked out file, and ,v files,
										# respectively
	my ($rev_count, $first_vl, $last_vl, $description,
			$rev_index, @rev_num, %checked_in, %author,
			$relative_comment_index, @comment_string,
			%comment);
	my ($num_version_labels, $label_index, @label_revision, $label,
			@new_label, $rcs_rev);
	my ($revision, %rcs_rev_num);
	my @remainder;
	my ($get_output, $rcs_output, $ci_output, $mv_output);
	my ($ci_command, $rcs_command, $wtr);
	my @hits;
	my ($num_fields);
	my $skipdirlock;							# if true, don't write conv.out
										# used only for single file operations
										# at the moment
	my $cd;
	my $cvs_dir;

	my @filenames;
	# We may have recieved a single file name to process...
	if ( -d $dir )
		{
		# change into the directory to be processed
		# open the current directory for listing
		# initialize the list of filenames
		# and set filenames equal to directory listing
		unless ( ( chdir $dir ) and ( opendir CURDIR, "." ) and ( @filenames = readdir CURDIR ) )
			{
			$cd = cwd;
			error_count 'error', \$errors, "skipping directory $dir from $cd";
			chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
			return ($errors, $warnings);
			}

		# clean up by closing the directory
		closedir(CURDIR);

		if ($options{'rcs-dirs-flat'} && $options{'cvs-module-path'})
			{
			my @cur_dir_names = split qr{[/\\]}, cwd;
			my $rel_cd = $cur_dir_names[-1];
			push @rel_dirs, $rel_cd;
			$cvs_dir = "$options{'cvs-module-path'}/"
			           . join "/", @rel_dirs;
			if (!-d $cvs_dir)
				{
				print "Creating directory \`$cvs_dir'\n";
				if (!mkpath ($cvs_dir))
					{
					pop @rel_dirs;
					error_count 'error', \$errors,
"failed to make directory \`$cvs_dir' - skipping directory \`$cd'";
					chdir $old_dir or die
"Failed to restore original directory (\`$old_dir'): ", $!, ", stopped";
					return ($errors, $warnings);
					# after all, we have nowhere to put
					# them...
					}
				}
			}

		}
	elsif ( -f $dir ) # we recieved a single file
		{
		push @filenames, $dir;
		$skipdirlock = 1;
		}
	else
		{
		$cd = cwd;
		error_count 'error', \$errors, "no such directory/file $dir from $cd\n";
		chdir $old_dir or die
"Failed to restore original directory ($old_dir): ", $!, ", stopped";
		return ($errors, $warnings);
		}

	# save the current directory
	$cd = cwd;

	# increment the global $curlevel variable
	$curlevel = $curlevel +1;

	# initialize a list for any subdirectories and any files
	# we need to process
	my $vcsdir = ""; 
	my (@subdirs, $fn, $file, @files, @pvcsarchives);

	# print "$cd:  " . join (", ", @filenames) . "\n";
	# hit_any_key;

	(@files, @pvcsarchives) = ( (), () );
	# begin a for loop to execute on each filename in the list @filename
	foreach $fn (@filenames)
		{
		# if the file is a directory...
		if (-d $fn)
			{
			# then if we are not expecting a flat arrangement of pvcs files
			# and we found a vcs directory add its files to @pvcsarchives
			if (!$options{'pvcs-dirs-flat'} and $fn =~ /^vcs$/i)
				{
				if ($options{verify} =~ /^locks$/ ) {
				if ( -f $donefile_name ) {
					print "Verified existence of lockfile $cd/$donefile_name."
							. ( ($options{mode} =~ /^convert$/) ? "  Skipping directory." : "" )
							. "\n" if ($options{verbose});
					next;
				} elsif ( $options{mode} =~ /^verify$/ ) {
					print "No lockfile found for $cd .\n";
					next;
				}
				}

				# else add the files in the vcs dir to our list of files to process
				error_count 'warning', \$warnings, "Found two vcs dirs in directory $cd.\n"
						if ($vcsdir and $options{warnings});

				$vcsdir = $fn;

				unless ( ( opendir VCSDIR, $vcsdir ) and ( @files = readdir VCSDIR ) )
					{
					error_count 'error', \$errors, "skipping directory &cd/$fn";
					next;
					}
				closedir VCSDIR;

				# and so we don't need to worry about where these
				# files came from later...
				foreach $file (@files)
					{
					push @pvcsarchives, "$vcsdir/$file" if (-f "$vcsdir/$file");
					}

				# don't want recursion here...
				@pvcsarchives = grep !/^\.\.?$/, @pvcsarchives;
				}
			elsif ($fn !~ /^\.\.?$/)
				{
				next if (!$options{'rcs-dirs-flat'} and $fn =~ /^rcs$/i);
				# include it in @subdir if it's not a parent directory
				push(@subdirs,$fn);
				}
			}
		# else if we are processing a flat arrangement of pvcs files...
		elsif ($options{'pvcs-dirs-flat'} and -f $fn)
			{
			if ($options{verify} =~ /^locks$/) {
				if ( -f $donefile_name) {
					print "Found lockfile $cd/$donefile_name."
						. ( ($options{mode} =~ /^convert$/) ? "  Skipping directory." : "" )
						. "\n" if ($options{verbose});
					last;
				} elsif ($options{mode} =~ /^verify$/) {
					print "No lockfile found for $cd .\n";
					last;
				}
			}
			# else add this to the list of files to process
			push (@pvcsarchives, $fn);
			}
		}

	# print "pvcsarchives:  " . join (", ", @pvcsarchives) . "\n";
	# print "subdirs:  " . join (", ", @subdirs) . "\n";
	# hit_any_key;

	# for loop of subdirs
	foreach (@subdirs)
		{
		# run execdir on each sub dir
		if ($maxlevel >= $curlevel)
			{
			my ($e, $w) = execdir ($_);
			$errors += $e;
			$warnings += $w;
			}
		}

	# Print output header for each directory
	print("Directory: $cd\n");

	# the @files variable should already contain the list of files
	# we should attempt to process
	if ( @pvcsarchives && ( $options{mode} =~ /^convert$/ ) )
		{
		# create an RCS directory in parent to store RCS files in
		if ( !( $options{'rcs-dirs-flat'} or (-d "RCS") or mkpath ( "RCS" ) ) )
			{
 			error_count 'error', \$errors, "failed to make directory $cd/RCS - skipping directory $cd";
			@pvcsarchives = ();
			# after all, we have nowhere to put them...
			}
		}

	# begin a for loop to execute on each filename in the list @files
	foreach $pvcsarchive (@pvcsarchives)
		{
		my $got_workfile = 0;
		my $got_version_labels = 0;
		my $got_description = 0;
		my $got_rev_count = 0;

		my $abs_file = $cd . "/" . $pvcsarchive;

		print("Verifying $abs_file...\n") if ($options{verbose});

		print "vlog $pvcsarchive\n";
		# FIXME: Quoting this is better than no quotes, but quotes in
		#        filenames remain unquoted.
		my $vlog_output = `vlog \"$pvcsarchive\"`;

		# Split the vcs status output into individual lines
		my @vlog_strings = split /\n/, $vlog_output;
		my $num_vlog_strings = @vlog_strings;
		$_ = $vlog_strings[0];
		if ( /^\s*$/ || /^vlog: warning/ )
			{
			error_count 'warning', \$warnings, "$abs_file is NOT a valid PVCS archive!!!\n";
			next;
			}

		my $num;
		# Collect all vlog output into appropriate variables
		#
		# This will ignore at the very least the /^\s*Archive:\s*/ field
		# and maybe more.  This should not be a problem.
		for ( $num = 0; $num < $num_vlog_strings; $num++ )
			{
			# print("$vlog_strings[$num]\n");
			$_ = $vlog_strings[$num];

			if( ( /^Workfile:\s*/ ) && (!$got_workfile ) )
				{
				my $num_fields;

				$got_workfile = 1;
				# get the string to the right of the above search (with any path stripped)
				$workfile = $';
				$num_fields = split /[\/\\]/, $workfile;
				if ( $num_fields > 1 ) 
					{ 
					$workfile = $_[$num_fields - 1 ];
					}

				$rcsarchive = $options{'rcs-dirs-flat'} ? "" : "RCS/";
				$rcsarchive .= $workfile;
				$rcsarchive .= $options{'rcs-extension'} if ($options{'rcs-extension'});
				print "Workfile is $workfile\n" if ($options{debug});
				}

			elsif ( ( /^Rev count:\s*/ ) && (!$got_rev_count ) )
				{
				$got_rev_count = 1;
				# get the string to the right of the above search
				$rev_count = $';
				print "Revision count is $rev_count\n";
				}

			elsif ( ( /^Version labels:\s*/ ) && (!$got_version_labels ) )
				{
				$got_version_labels = 1;
				$first_vl = $num+1;
				print "Version labels start at $first_vl\n" if ($options{debug});
				}

			elsif ( ( /^Description:\s*/ ) && (!$got_description ) )
				{
				$got_description = 1;
				$description = $vlog_strings[$num+1];
				print "Description is `$description'\n" if ($options{debug});
				$last_vl = $num++ - 1;
				}

			elsif ( /^Rev\s+/ ) # get all the revision information at once
				{
				$rev_index = 0;
				@rev_num = ();
				while ( $rev_index < $rev_count )
					{
					$_ = $vlog_strings[$num];
					/^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/;
					$rev_num[$rev_index] = $1;
					print "Found revision: $rev_num[$rev_index]\n" if ($options{debug});
					die "Not a valid revision ($rev_num[$rev_index]).\n"
						if ($rev_num[$rev_index] !~ /^(\d+\.)(\d+\.\d+\.)*\d+$/);

					$_ = $vlog_strings[$num+1];
					/^\s*Locked\s*/ and $num++;

					$_ = $vlog_strings[$num+1];
					/^\s*Checked in:\s*/;
					$checked_in{$rev_num[$rev_index]} = "\"" . $' . "\"";
					print "Checked in: $checked_in{$rev_num[$rev_index]}\n" if ($options{debug});

					$_ = $vlog_strings[$num+3];
					/^\s*Author id:\s*/;
					my @fields = split;
					$author{$rev_num[$rev_index]} = "\"" . $fields[2] . "\"";
					print "Author: $author{$rev_num[$rev_index]}\n" if ($options{debug});

					my @branches = ();
					$_ = $vlog_strings[$num+1];
					if (/^\s*Branches:\s*/)
						{ 
						$num++;
						@branches = split /\s+/, $';
						}

					$relative_comment_index = 0;
					@comment_string = ();
 					while (($num + 4 + $relative_comment_index) < @vlog_strings)
						{
						last if $vlog_strings[$num+4+$relative_comment_index]
						          =~ /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/
						        && $vlog_strings[$num+3+$relative_comment_index]
						          =~ /^-{35}$/;

						# We need the \n added for multi-line comments.  There is no effect for
						# single-line comments since RCS inserts the \n if it doesn't exist already
						# print "Found commment line: $vlog_strings[$num+4+$relative_comment_index]\n"
						#	if ($options{debug});
						push @comment_string, $vlog_strings[$num+4+$relative_comment_index], "\n";
						$relative_comment_index += 1;
						}
					# print "Popped from comment: " . join ("", splice (@comment_string, -2)) 
					#		. "\n"
					#	if ($options{debug});
					# Pop the "-+" or "=+" line from the comment
					while ( (pop @comment_string) !~ /^-{35}|={35}$/ )
						{}
					$comment{$rev_num[$rev_index]} = join "", @comment_string;

					$num += ( 4 + $relative_comment_index );
					print "Got comment for $rev_num[$rev_index]\n" if ($options{debug});
					print "comment string: $comment{$rev_num[$rev_index]}\n" if ($options{debug});
					$rev_index += 1;
					} # while ( $rev_index < $rev_count )
				$num -= 1; #although there should be nothing left for this to matter
				} # Get Rev information
			} # for ($num = 0; $num < $num_vlog_strings; $num++)
		# hit_any_key if ($options{debug});
		# Create RCS revision numbers corresponding to PVCS version numbers
		my @rcs_rev_nums;
		foreach $revision (@rev_num)
			{
			$rcs_rev_num{ $revision } = &pvcs_to_rcs_rev_number( $revision );
			push @rcs_rev_nums, $rcs_rev_num{$revision};
			print"PVCS revision is $revision; RCS revision is $rcs_rev_num{ $revision }\n"
					if ($options{debug});
			}

		# Sort the revision numbers - PVCS and RCS store them in different orders
		# Clear @_ so we don't pass anything in by accident...
		@_ = ();
		@rev_num = sort revisions @rev_num;
		print "Sorted rev_nums:\n" . join ("\n", @rev_num) . "\n" if ($options{debug});
		# hit_any_key;

		# Loop through each version label, checking for need to relabel ' ' with '_'.
		$num_version_labels = $last_vl - $first_vl + 1;
		print "Version label count is $num_version_labels\n";
		for( $i = $first_vl; $i <= $last_vl; $i += 1 )
			{
			# print("$vlog_strings[$i]\n");
			$label_index = $i - $first_vl;
			$_=$vlog_strings[$i];
			print "Starting with string '$_'\n" if ($options{debug});
			my @fields = split /\"/;
			$label = $fields[1];
			print "Got label '$label'\n" if ($options{debug});
			@fields = split /\s+/, $fields[2];
			$label_revision[$label_index] = $fields[2];
			print "Original label is $label_revision[$label_index]\n" if ($options{debug});

			# Create RCS revision numbers corresponding to PVCS version numbers by
			# adding 1 to the revision number (# after last .)
			$label_revision[ $label_index ] = pvcs_to_rcs_rev_number( $label_revision [ $label_index ] );
			# replace ' ' with '_', if needed
			$_=$label;
			$new_label[$label_index] = $label;
			$new_label[$label_index] =~ s/ /_/g;
			$new_label[$label_index] =~ s/\./_/g;
			$new_label[$label_index] = "\"" . $new_label[$label_index] . "\"";
			print"Label $new_label[$label_index] is for revision $label_revision[$label_index]\n" if ($options{debug});
			}
		
		##########
		#
		# See if the RCS archive is up to date with the PVCS archive
		#
		##########
		my $cvsarchive;
		$cvsarchive = "$cvs_dir/$rcsarchive" if $options{'cvs-module-path'};
		$cvsarchive .= $rcsarchive;
		if ($options{verify} =~ /^locks|exists$/ and -f $cvsarchive)
			{
			print "Verified existence of "
			    . ($options{'cvs-module-path'} ? $cvsarchive : "$cd/$rcsarchive")
			    . "."
					. ( ($options{mode} =~ /^convert$/) ? "  Skipping." : "" )
					. "\n" if ($options{verbose});
			next;
			}

		# Create RCS archive and check in all revisions, then label.
		my $first_time = 1;
		foreach $revision (@rev_num)
			{
			# print "get -p$revision $pvcsarchive >$workfile\n";
			print "get -r$revision $pvcsarchive\n";
			# $vcs_output = `vcs -u -r$revision $pvcsarchive`;
			# $get_output = `get -p$revision $pvcsarchive >$workfile`;
			# FIXME: Doesn't handle quotes in filenames as FIXME above.
			$get_output = `get -r$revision \"$pvcsarchive\"`;

			# if this is the first time, delete the rcs archive if it exists
			# need for $options{verify} == none
			unlink $rcsarchive if ($first_time and $options{verify} =~ /^none$/ and -f $rcsarchive);

			# Also check here whether this file ought to be "binary"
			if ( $first_time )
				{
				$rcs_command = "$rcs_base_command -i";
				if ( ( @hits = grep { $workfile =~ /$_/ } keys %bin_ext ) || $options{'force-binary'} )
					{
					$rcs_command .= " -kb";
					$workfile =~ /$hits[0]/ if (@hits);
					print "Binary attribute -kb added ("
						. (@hits ? "file type is '$bin_ext{$hits[0]}' for extension '$&'" : "forced")
						. ")\n";
					}

				# FIXME: Doesn't handle quotes and other special characters in
				#        filenames as two FIXMEs above.
				$rcs_command .= " \"$workfile\"";

				# print and execute the rcs archive initialization command
				print "$rcs_command\n";
				$wtr = new IO::File "|$rcs_command";
				$wtr->print ($description);
				$wtr->print ("\n") unless ($description =~ /\n$/s);
				$wtr->print (".\n");
				$wtr->close;

				# $rcs_output = `$rcs_base_command -i -kb $workfile`;
				}

			# if this isn't the first time, we need to lock the rcs branch
			#
			# This is a little messy, but it works.  Some extra locking is attempted.
			# (This happens the first time a branch is used, at the least)
			my $branch = "";
			my @branch;
			@branch = split /\./, $rcs_rev_num{$revision};
			pop @branch;
			$branch = join ".", @branch if @branch != 1;

			# FIXME: Quotes around file names handles spaces but not shell
			#        metacharacters in file names.
			unless ($first_time)
			{
				print "$rcs_base_command -l$branch \"$workfile\"\n"
					if $options{'debug'};
				$rcs_output = `$rcs_base_command -l$branch \"$workfile\"`;
			}

			# If an empty comment is specified, RCS will not check in the file;
			# check for this case.	(but an empty -t- description is fine - go figure!)
			# Since RCS will pause and ask for a comment if one is not given,
			# substitute a dummy comment "no comment".
			$comment{$revision} =~ /^\s*$/ and $comment{$revision} = "no comment\n";

			$ci_command = $ci_base_command;
			$ci_command .= " -f -r$rcs_rev_num{$revision} -d$checked_in{$revision}"
					. " -w$author{$revision}";

			$ci_command .= " \"$workfile\"";

			# print and execute the ci command
			print "$ci_command\n";
			$wtr = new IO::File "|$ci_command";
			$wtr->print ($comment{$revision});
			$wtr->print ("\n") unless ($comment{$revision} =~ /\n$/s);
			$wtr->print (".\n");
			$wtr->close;
			# $ci_output = `$ci_command`;
			# $ci_output = `cat $tmpdir/ci.out`;

			$first_time = 0 if ($first_time);
			} # foreach revision

		# Keep track of 1.*, 2.*, etc. branches as they are created.
		my %trunk_branches;

		# Attach version labels
		for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 )
			{
			print "$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"\n"
				if $options{'debug'};
			$rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`;
			print "Version label $new_label[$i] added to revision $label_revision[$i]\n";

			# If the label revision is attached to a 1.* revision on the trunk
			# when a 2.* revision exists, then 1.MAX needs to be branched to
			# allow commits to this label.  This applies to 2.* when 3.*
			# exists, as well.
			if ($label_revision[$i] !~ /\./)
			{
				# This revision is attached to the trunk.
				# $rcs_rev_nums[0] will always be the max revision.
				print "Label `$new_label[$i]' moved from $label_revision[$i] to ";
				if (exists $trunk_branches{$label_revision[$i]})
				{
					$label_revision[$i] = $trunk_branches{$label_revision[$i]};
				}
				else
				{
					# Attached to X.* with X < M
					my @X_revs = grep /^$label_revision[$i]\./, @rcs_rev_nums;
					# Need a _NEW_ branch from $X_revs[0] to attach
					# to.  CVS could do this easily, but our archive
					# isn't in a CVS repository yet.
					my @tmp_lbl = @label_revision;
					my @branch_nums = grep s/^\Q$X_revs[0]\E\.0\.(\d+)$/$1/, @tmp_lbl;
					@tmp_lbl = @rcs_rev_nums;
					push @branch_nums,
					grep (s/^\Q$X_revs[0]\E\.(\d+)\.\d+$/$1/, @tmp_lbl);
					my $max = 0;
					foreach my $num (@branch_nums)
					{
						$max = $num if $num > $max;
					}
					$max += 2;
					$trunk_branches{$label_revision[$i]} = "$X_revs[0].0.$max";
					$label_revision[$i] = "$X_revs[0].0.$max";
				}
				print "$label_revision[$i].\n";
			}

			$rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`;
			print "Version label $new_label[$i] added to revision $label_revision[$i]\n";

			if ($label_revision[$i] =~ /^(.*)\.0\./)
			{
				my $base = $1;
				my $rootlbl = $new_label[$i];
				$rootlbl =~ s/.$/_broot$&/;
				$rcs_output = `$rcs_base_command -n$rootlbl:$base \"$workfile\"`;
				print "Version label $rootlbl added to revision $base\n";
			}

			} # foreach label

		if ($options{'cvs-module-path'})
		{
				print "Moving $rcsarchive to $cvsarchive\n";
				move $rcsarchive, $cvsarchive or warn "Move failed: $!";
		}

		# hit_any_key;
		} # foreach pvcs archive file

	# We processed a vcs directory, so if there were any files, lock it.
	# We are guaranteed to have made the attempt at
	#
	# $skipdirlock gets set if a single file name was passed to this function to enable
	# a '$0 *' operation...
	if ( @pvcsarchives && !$skipdirlock)
		{
		my $fh = new IO::File ">>$donefile_name" or new IO::File ">$donefile_name";
		if ($fh)
			{
			$fh->close;
			}
		else
			{
			error_count 'error', \$errors, "couldn't create lockfile $cd/$donefile_name";
			}
		}

	$curlevel = $curlevel - 1;

	chdir $old_dir
		or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";

	# Update the relative directory path.
	pop @rel_dirs if -d $dir;

	return ($errors, $warnings);
	}



#
# This function effectively does a cmp between two revision numbers
# It is intended to be passed into Perl's sort routine.
#
# the pvcs_out is not implemented well.  It should probably be
# returnning $b[0] <=> $a[0] rather than $a[0] <=> $b[0]
#
# The @_ argument implementation was going to be used for revision
# comparison as an aid to remove the /^\sRev/ in revision comment
# error.  The effort was fruitless at the time.
sub revisions
	{
	my @a = split /\./, (defined $a) ? $a : shift;
	my @b = split /\./, (defined $b) ? $b : shift;
	my $function = @_ ? shift : 'rcs_in';
	my ($i, $ret_val);

	die "Not enough arguments to revisions : a = ", join (".", @a),
			"; b = ", join (".", @b), ", stopped"
		unless (@a and @b);

	for ($i = 0; $i < scalar( @a ) && $i < scalar( @b ); $i++)
		{
		$a[$i] == $b[$i] or return ($a[$i] <=> $b[$i]);
		}

	return 0 if (scalar (@a) == scalar (@b));

	if ($function eq 'rcs_in')
		{
		return (($i == @b) || -1);
		}
	elsif ($function eq 'pvcs_out')
		{
		return (($i == @a) || -1);
		}
	else
		{
		die "error - Invalid function type passed to revisions ($function)", ", stopped";
		}
	}



sub pvcs_to_rcs_rev_number
	{
	my($input, $num_fields, @rev_string, $return_rev_num, $i);

	$input = $_[0];
	$num_fields = split /\./, $input;
	@rev_string = @_;
	# @rev_string[$num_fields-1] += 1;

	for( $i = 1; $i < $num_fields; $i += 1 )
		{
		if ( $i % 2 )
			{
			# DRP: 10/1
			# RCS does not allow revision zero
			$rev_string[ $i ] += 1;
			}
		elsif ( $i )
			{
			# DRP: 10/1
			# Branches must have even references for compatibility
			# with CVS's magic branch numbers.
			# (Indexes 2, 4, 6...)
			$rev_string[ $i ] *= 2;
			}
		}

	# If this is a branch revision # (PVCS: a.b.c.*) then we want the CVS
	# revision # instead.  It's okay to do this conversion here since we
	# never commit to branches.  We'll only get a PVCS revision # in that
	# form when looking through the revision labels.
	if ($input =~ /\*$/)
		{
		pop @rev_string;
		# If there is only one entry in @rev_string, this is a
		# revision that needs to be attached to the trunk.  Let it be
		# for now.  It might require a new branch, but we can't decide
		# which branches are valid to create before we know what
		# branches already exist.
		push @rev_string, splice (@rev_string, -1, 1, "0")
			unless @rev_string == 1;
		}

	$return_rev_num = join ".", @rev_string;
	return $return_rev_num;
	}





###
###
###
###
###
###   MAIN program: checks to see if there are command line parameters
###
###
###
###
###




	
# and read the options
die $usage
	unless GetOptions (\%options, "h|help" => \&exit_help, 
	                   "recurse!", "mode|m=s", "errorfiles!", "l",
	                   "rcs-dirs|rcs-directories|r=s",
	                   "pvcs-dirs|pvcs-directories|p=s", "test-binaries|t!",
	                   "rcs-extension=s", "verify|v=s", "vcsid|i=s", "verbose!",
	                   "debug!", "force-binary!", "cvs-branch-labels!",
	                   "warnings|w!", "cvs-module-path|d=s");



#
# Special processing for -l !^#%$^@#$%#$
#
# At the moment, -l overrides --recurse, regardless of the order the
# options were passed in
#
$options{recurse} = 0 if defined $options{l};
delete $options{l};



# Make sure we got acceptable values for rcs-dirs and pvcs-dirs
my @hits = grep /^$options{'rcs-dirs'}/i, ("leaf", "flat");
@hits == 1 or die
		  "$0: $options{'rcs-dirs'} invalid argument to --rcs-dirs or ambiguous\n"
		. "    abbreviation.\n"
		. "    Must be one of: 'leaf' or 'flat'.\n"
		. $usage;
$options{'rcs-dirs'} = $hits[0];
$options{'rcs-dirs-flat'} = ($options{'rcs-dirs'} =~ /flat/);
delete $options{'rcs-dirs'};

@hits = grep /^$options{'pvcs-dirs'}/i, ("leaf", "flat");
@hits == 1 or die
		  "$0: $options{'pvcs-dirs'} invalid argument to --pvcs-dirs or ambiguous\n"
		. "    abbreviation.\n"
		. "    Must be one of: 'leaf' or 'flat'.\n"
		. $usage;
$options{'pvcs-dirs'} = $hits[0];
$options{'pvcs-dirs-flat'} = ($options{'pvcs-dirs'} =~ /flat/);
delete $options{'pvcs-dirs'};

# and for verify
@hits = grep /^$options{verify}/i, ("none", "locks", "exists", "lockdates", "revs", "full");
@hits == 1 or die
		  "$0: $options{verify} invalid argument to --verify or ambiguous\n"
		. "    abbreviation.\n"
		. "    Must be one of: 'none', 'locks', 'exists', 'lockdates', 'revs',\n"
		. "    or 'full'.\n"
		. $usage;
$options{verify} = $hits[0];
$options{verify} =~ /^none|locks|exists$/ or die
		  "$0: --verify=$options{verify} unimplemented.\n"
		. $usage;

# and mode
@hits = grep /^$options{mode}/i, ("convert", "verify");
@hits == 1 or die
		  "$0: $options{mode} invalid argument to --mode or ambiguous abbreviation.\n"
		. "    Must be 'convert' or 'verify'.\n"
		. $usage;
$options{mode} = $hits[0];

$options{'cvs-branch-labels'} or die
		  "$0: RCS Branch Labels unimplemented.\n"
		. $usage;

# export VCSID into th environment for ourselves and our children
$ENV{VCSID} = $options{vcsid};



#
# Verify we have all the binary executables we need to run this script
#
# Allowed this feature to be disabled in case which is missing or we are
# running on a system which does not return error codes properly (e.g. WIN95)
#
#      -- i.e. I don't feel like grepping output yet. --
#
my @missing_binaries = ();
if ($options{'test-binaries'})
	{
	foreach (@bin_dependancies)
		{
		my $output = qx/which $_ 2>&1/;
		print $output if $options{verbose} && $output;
		if ($? || $output =~ /^no/)
			{
			push @missing_binaries, $_;
			}
		}

	if (scalar @missing_binaries)
		{
		print STDERR "The following executables were not found in your PATH: "
			. join ( " ", @missing_binaries )
			. "\n"
			. "You must correct this before continuing.\n";
		exit 1;
		}
	}
delete $options{'test-binaries'};



#
# set up our base archive manipulation commands
#

# set up our rcs_command mods
$rcs_base_command = "rcs";
$rcs_base_command .= " -x$options{'rcs-extension'}"
	if $options{'rcs-extension'};

# set up our rcs_command mods
$ci_base_command = "ci";
$ci_base_command .= " -x$options{'rcs-extension'}"
	if $options{'rcs-extension'};



#
# So our logs fill in a manner we can monitor with 'tail -f' fairly easily:
#
STDERR->autoflush (1);
STDOUT->autoflush (1);



# Initialize the globals we use to keep track of recursion
if ($options{recurse})
	{
	$maxlevel = 10000;		# Arbitrary recursion limit
	}
else
	{
	$maxlevel = 1;
	}
delete $options{recurse};

# So we can lock the directories behind us
$donefile_name = $options{'rcs-dirs-flat'} ? "" : "RCS/";
$errorfile_name = $donefile_name . "#conv.errors";
$donefile_name .= "#conv.done";



#
# start the whole thing and drop the return code on exit
#
push @ARGV, "." unless (@ARGV);
while ($_ = shift)
	{
	# reset the recursion level (corresponds to directory depth)
	# level 0 is the first directory we enter...
	$curlevel = -1;
	my ($e, $w) = execdir($_);
	$errors += $e;
	$warnings += $w;
	}



print STDERR "$0:  " . ($errors ? "Aborted" : "Done") . ".\n";
print STDERR "$0:  ";
print STDERR ($errors ? $errors : "No") . " error" . (($errors != 1) ? "s" : "");
print STDERR ", " . ($warnings ? $warnings : "no") . " warning" . (($warnings != 1) ? "s" : "")
		if ($options{warnings});
print STDERR ".\n";



#
# Woo-hoo!  We made it!
#
exit $errors;
