PageRenderTime 28ms CodeModel.GetById 12ms app.highlight 8ms RepoModel.GetById 1ms app.codeStats 0ms

/contrib/cvs/contrib/pvcs2rcs.in

https://bitbucket.org/freebsd/freebsd-head/
Autoconf | 1150 lines | 689 code | 162 blank | 299 comment | 102 complexity | acc28f60307d9787e26ef68d35dd6ea5 MD5 | raw file
   1#! @PERL@
   2# ---------------------------------
   3# This program is free software; you can redistribute it and/or modify
   4# it under the terms of the GNU General Public License as published by
   5# the Free Software Foundation; either version 2, or (at your option)
   6# any later version.
   7#
   8# This program is distributed in the hope that it will be useful,
   9# but WITHOUT ANY WARRANTY; without even the implied warranty of
  10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11# GNU General Public License for more details.
  12
  13###########################################################################
  14# FUNCTION:
  15# To recursively walk through a PVCS archive directory tree (archives
  16# located in VCS/ or vcs/ subdirectories) and convert them to RCS archives.
  17# The RCS archive name is the PVCS workfile name with ",v" appended.
  18#
  19# SYNTAX:
  20# pvcs_to_rcs.pl --help
  21#
  22# where -l indicates the operation is to be performed only in the current
  23# directory (no recursion)
  24# 
  25# EXAMPLE:
  26# pvcs_to_rcs
  27# Would walk through every VCS or vcs subdir starting at the current directory,
  28# and produce corresponding RCS archives one level above the VCS or vcs subdir.
  29# (VCS/../RCS/)
  30#
  31# NOTES:
  32# * This script performs little error checking and logging
  33#   (i.e. USE AT YOUR OWN RISK)
  34# * This script was last tested using ActiveState's port of Perl 5.005_02
  35#   (internalcut #507) under Win95, though it does compile under Perl-5.00404
  36#   for Solaris 2.4 run on a Solaris 2.6 system.  The script crashed
  37#   occasionally under ActiveState's port of Perl 5.003_07 but this stopped
  38#   happening with the update so if you are having problems, try updating Perl.
  39#   Upgrading to cut #507 also seemed to coincide with a large speed
  40#   improvement, so try and keep up, hey?  :)  It was executed from MKS's
  41#   UNIX tools version 6.1 for Win32's sh.  ALWAYS redirect your output to
  42#   a log!!!
  43# * PVCS archives are left intact
  44# * RCS archives are created in VCS/../RCS/ (or ./RCS using '-pflat')
  45# * Branch labels in this script will be attached to the CVS magic
  46#   revision number.  For branch a.b.c of a particular file, this means
  47#   the label will be attached to revision a.b.0.c of the converted
  48#   file.  If you use the TrunkTip (1.*) label, be aware that it will convert
  49#   to RCS revision 0.1, which is useless to RCS and CVS.  You'll probably
  50#   have to delete these.
  51# * All revisions are saved with correct "metadata" (i.e. check-in date,
  52#   author, and log message).  Any blank log message is replaced with
  53#   "no comment".  This is because RCS does not allow non-interactive
  54#   check in of a new revision without a comment string.
  55# * Revision numbers are incremented by 1 during the conversion (since
  56#   RCS does not allow revision 1.0).
  57# * All converted branch numbers are even (the CVS paradigm)
  58# * Version labels are assigned to the appropriate (incremented) revision
  59#   numbers.  PVCS allows spaces and periods in version labels while RCS
  60#   does not.  A global search and replace converts " " and "." to "_"
  61#   There may be other cases that ought to be added.
  62# * Any working (checked-out) copies of PVCS archives
  63#   within the VCS/../ or vcs/../ (or possibly ./ with '-pflat')
  64#   will be deleted (or overwritten) depending on your mode of
  65#   operation since the current ./ is used in the checkout of each revision.
  66#   I suppose if development continues these files could be redirected to
  67#   temp space rather than ./ .
  68# * Locks on PVCS archives should be removed (or the workfiles should be
  69#   checked-in) prior to conversion, although the script will blaze through
  70#   the archive nonetheless (But you would lose any checked out revision(s))
  71# * The -kb option is added to the RCS archive for workfiles with the following
  72#   extensions: .bin .out .btl .rom .a07 .lib .exe .tco .obj .t8u .c8u .o .lku
  73#   .a and a few others.  The %bin_ext variable holds these values in regexp
  74#   form.
  75# * the --force-binary option can be used to convert binary files which don't
  76#   have proper extensions, but I'd *probably* edit the %bin_ext variable.
  77# * This script will abort occasionally with the error "invalid revision
  78#   number".  This is known to happen when a revision comment has
  79#   /^\s*Rev/ (Perl regexp notation) in it.  Fix the comment and start over.
  80#   (The directory locks and existance checking make this a fairly quick
  81#   process.)
  82# * This script writes lockfiles in the RCS/ directories.  It will also not
  83#   convert an archive if it finds the RCS Archive existant in the RCS/
  84#   directory.  This enables the conversion to quickly pick up where it left
  85#   off after errors or interrupts occur.  If you interrupt the script make
  86#   sure you delete the last RCS Archive File which was being written.
  87#   If you recieve the "Invalid revision number" error, then the RCS archive
  88#   file for that particular PVCS file will not have been created yet.
  89# * This script will not create lockfiles when processing single
  90#   filenames passed into the script, for hopefully obvious reasons.
  91#   (lockfiles lock directories - DRP)
  92# * Log the output to a file.  That makes it real easy to grep for errors
  93#   later.  (grep for "^[ \t]*(rcs|ci):" and be aware I might have missed
  94#   a few cases (get?  vcs?) !!!) *** Also note that this script will
  95#   exibit some harmless RCS errors.  Namely, it will attempt to lock
  96#   branches which haven't been created yet. ***
  97# * I tried to keep the error and warning info up to date, but it seems
  98#   to mean very little.  This script almost always exits with a warning
  99#   or an error that didn't seem to cause any harm.  I didn't trace it
 100#   and our imported source checks out and builds...
 101#   It is probably happening when trying to convert empty directories
 102#   or read files (possibly checked out workfiles ) which are not
 103#   pvcs_archives.
 104# * You must use the -pflat option when processing single filenames
 105#   passed as arguments to the script.  This is probably a bug.
 106# * questions, comments, additions can be sent to info-cvs@nongnu.org
 107#########################################################################
 108
 109
 110
 111#
 112# USER Configurables
 113#
 114
 115# %bin_ext should be editable from the command line.
 116#
 117# NOTE:  Each possible binary extension is listed as a Perl regexp
 118#
 119# The value associated with each regexp key is used to print a log
 120# message when a binary file is found.
 121my %bin_ext =
 122	(
 123	'\.(?i)bin$' => "Binary",
 124	'\.(?i)out$' => "Default Compiler Output",
 125	'\.(?i)btl$' => "",
 126	'\.(?i)rom$' => "",
 127	'\.(?i)a07$' => "",
 128	'\.(?i)lib$' => "DOS/Wintel/Netware Compiler Library",
 129	'\.(?i)lif$' => "Netware Binary File",
 130	'\.(?i)exe$' => "DOS/Wintel Executable",
 131	'\.(?i)tco$' => "",
 132	'\.(?i)obj$' => "DOS/Wintel Compiler Object",
 133	'\.(?i)res$' => "DOS/Wintel Resource File",
 134	'\.(?i)ico$' => "DOS/Wintel Icon File",
 135	'\.(?i)nlm$' => "Netware Loadable Module",
 136	'\.(?i)t8u$' => "",
 137	'\.(?i)c8u$' => "",
 138	'\.(?i)lku$' => "",
 139	'\.(?i)(bmp|gif|jpg|jpeg|jfif|tif|tiff|xbm)$' => "Image",
 140	'\.(?i)dll$' => "DOS/Wintel Dynamically Linked Library",
 141	'\.o$' => "UNIX Compiler Object",
 142	'\.a$' => "UNIX Compiler Library",
 143	'\.so(\.\d+\.\d+)?$' => "UNIX Shared Library"
 144	);
 145
 146# The binaries this script is dependant on:
 147my @bin_dependancies = ("vcs", "vlog", "rcs", "ci");
 148
 149# Where we should put temporary files
 150my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/var/tmp";
 151
 152# We use these...
 153use strict;
 154
 155use Cwd;
 156use File::Path;
 157use IO::File;
 158use Getopt::Long;
 159	$Getopt::Long::bundling = 1;
 160#	$Getopt::Long::ignorecase = 0;
 161
 162my $usage = "\
 163usage:  $0 -h
 164        $0 [-lt] [-i vcsid] [-r flat|leaf] [-p flat|leaf] [-x rcs_extension]
 165		        [-v none|locks|exists] [options] [path...]
 166";
 167
 168my $help = "\
 169$usage
 170     ----------------------------           -----------------------------------
 171     -h | --Help                            Print this text
 172
 173     General Settings
 174     ----------------------------           -----------------------------------
 175     --Recurse                              Recurse through directories
 176                                            (default)
 177     -l | --NORecurse                       Process only .
 178     --Errorfiles                           Save a count of conversion errors
 179                                            in the RCS archive directory
 180                                            (default) (unimplemented)
 181     --NOErrorfiles                         Don't save a count of conversion
 182                                            errors (unimplemented)
 183     ( -m | --Mode ) Convert                Convert PVCS files to RCS files
 184                                            (default)
 185     ( -m | --Mode ) Verify                 Perform verification ONLY (unimplemented)
 186     ( -v | --VERIfy ) None                 Always replace existing RCS files
 187     ( -v | --VERIfy ) LOCKS                Same as exists unless a #conv.done
 188                                            file exists in the RCS directory.
 189                                            In that case, only the #conv.done
 190                                            file's existance is verified for
 191                                            that directory.  (default)
 192     ( -v | --VERIfy ) Exists               Don't replace existing RCS files
 193     ( -v | --VERIfy ) LOCKDates            Verify that an existing RCS file's
 194                                            last modification date is older
 195                                            than that of the lockfile
 196                                            (unimplemented)
 197     ( -v | --VERIfy ) Revs                 Verify that the PVCS archive files
 198                                            and RCS archive file contain the
 199                                            same number of corresponding
 200                                            revisions.  Add only new revisions
 201                                            to the RCS file.  (unimplemented)
 202     ( -v | --VERIfy ) Full                 Perform --verify=Revs and confirm
 203                                            that the text of the revisions is
 204                                            identical.  Add only new revisions
 205                                            unless an error is found.  Then
 206                                            erase the RCS archive and recreate
 207                                            it.  (unimplemented)
 208     -t | --Test-binaries                   Use 'which' to check \$PATH for
 209                                            the binaries required by this
 210                                            script (default)
 211     --NOTest-binaries                      Don't check for binaries
 212     --VERBose                              Enable verbose output
 213     --NOVerbose                            Disable verbose output (default)
 214     -w | --Warnings                        Print warning messages (default)
 215     --NOWarnings                           Don't print warning messages
 216
 217     RCS Settings
 218     ----------------------------           -----------------------------------
 219     ( -r | --RCS-Dirs ) leaf               RCS files stored in ./RCS (default)
 220     ( -r | --RCS-Dirs ) flat               RCS files stored in .
 221                                            (unimplemented)
 222     ( -x | --RCS-Extension )               Set RCS file extension
 223                                            (default = ',v')
 224     --Force-binary                         Pass '-kb' to 'rcs -i' regardless of
 225                                            the file extension
 226     --NOForce-binary                       Only use '-kb' when the file has
 227                                            a binary extension (default)
 228     --Cvs-branch-labels                    Use CVS magic branch revision
 229                                            numbers when attaching branch
 230                                            labels (default)
 231     --NOCvs-branch-labels                  Attach branch labels to RCS branch
 232                                            revision numbers (unimplemented)
 233
 234     PVCS Settings
 235     ----------------------------           -----------------------------------
 236     ( -p | --Pvcs-dirs ) leaf              PVCS files expected in ./VCS
 237                                            (default)
 238     ( -p | --Pvcs-dirs ) flat              PVCS files expected in .
 239     ( -i | --VCsid ) vcsid                 Use vcsid instead of \$VCSID
 240
 241     --------------------------------------------------------------------------
 242     The optional path argument should contain the name of a file or directory
 243     to convert.  If not given, it will default to '.'.
 244     --------------------------------------------------------------------------
 245";
 246
 247
 248
 249#
 250# Initialize globals
 251#
 252
 253my ($errors, $warnings) = (0, 0);
 254my ($curlevel, $maxlevel);
 255my ($rcs_base_command, $ci_base_command);
 256my ($donefile_name, $errorfile_name);
 257
 258# set up the default options
 259my %options = (
 260	recurse => 1,
 261	mode => "convert",
 262	errorfiles => 1,
 263	'rcs-dirs' => "leaf",
 264	'rcs-extension' => ",v",
 265	'force-binary' => 0,
 266	'cvs-branch-labels' => 1,
 267	'pvcs-dirs' => "leaf",
 268	verify => "locks",
 269	'test-binaries' => 1,
 270	vcsid => $ENV{VCSID} || "",
 271	verbose => 0,
 272	debug => 0,
 273	warnings => 1
 274	);
 275
 276
 277
 278# This is untested except under Solaris 2.4 or 2.6 and
 279# may not be portable
 280#
 281# I think the readline lib or some such has an interface
 282# which may enable this now.  The perl installer sure looks
 283# like it's testing this kind of thing, anyhow.
 284sub hit_any_key
 285	{
 286	STDOUT->autoflush;
 287	system "stty", "-icanon", "min", "1";
 288
 289	print "Hit any key to continue...";
 290	getc;
 291
 292	system "stty", "icanon", "min", "0";
 293	STDOUT->autoflush (0);
 294
 295	print "\nI always wondered where that key was...\n";
 296	}
 297
 298
 299
 300# print the usage
 301sub print_usage
 302	{
 303	my $fh = shift;
 304	unless (ref $fh)
 305		{
 306		my $fdn = $fh ? $fh : "STDERR";
 307		$fh = new IO::File;
 308		$fh->fdopen ($fdn, "w");
 309		}
 310
 311	$fh->print ($usage);
 312	}
 313
 314# print the help
 315sub print_help
 316	{
 317	my $fh = shift;
 318	unless (ref $fh)
 319		{
 320		my $fdn = $fh ? $fh : "STDOUT";
 321		$fh = new IO::File;
 322		$fh->fdopen ($fdn, "w");
 323		}
 324
 325	$fh->print ($help);
 326	}
 327
 328# print the help and exit $_[0] || 0
 329sub exit_help
 330	{
 331	print_help;
 332	exit shift || 0;
 333	}
 334
 335sub error_count
 336	{
 337	my $type = shift or die "$0:  error - error_count usage:  error_count type [, ref] [, LIST]\n";
 338	my $error_count_ref;
 339	my $outstring;
 340
 341	if (ref ($_[0]) && ref ($_[0]) == "SCALAR")
 342		{
 343		$error_count_ref = shift;
 344		}
 345	else
 346		{
 347		$error_count_ref = \$errors;
 348		}
 349	$$error_count_ref++;
 350
 351	push @_, "something wrong.\n" unless ( @_ > 0 );
 352
 353	$outstring = sprintf "$0:  $type - " . join ("", @_);
 354	$outstring .= sprintf " - $!\n" unless ($outstring =~ /\n$/);
 355
 356	print STDERR $outstring;
 357
 358	if ($options{errorfiles})
 359		{
 360		my $fh = new IO::File ">>$errorfile_name" or new IO::File ">$errorfile_name";
 361		if ($fh)
 362			{
 363			$fh->print ($$error_count_ref . "\n");
 364			$fh->print ($outstring);
 365			$fh->close;
 366			}
 367		else
 368			{
 369			my $cd = cwd;
 370			print STDERR "$0: error - failed to open errorfile $cd/$errorfile_name - $!\n"
 371					if ($options{debug});
 372			}
 373		}
 374
 375	return $$error_count_ref;
 376	}
 377
 378
 379
 380# the main procedure that is run once in each directory
 381sub execdir
 382	{
 383	my $dir = shift;
 384	my ($errors, $warnings) = (0, 0);					# We return these error counters
 385	my $old_dir = cwd;
 386
 387	local ($_, @_);
 388
 389	my $i;									# Generic counter
 390	my ($pvcsarchive, $workfile, $rcsarchive);				# .??v, checked out file, and ,v files,
 391										# respectively
 392	my ($rev_count, $first_vl, $last_vl, $description,
 393			$rev_index, @rev_num, %checked_in, %author,
 394			$relative_comment_index, @comment_string,
 395			%comment);
 396	my ($num_version_labels, $label_index, @label_revision, $label,
 397			@new_label, $rcs_rev);
 398	my ($revision, %rcs_rev_num);
 399	my ($get_output, $rcs_output, $ci_output, $mv_output);
 400	my ($ci_command, $rcs_command, $wtr);
 401	my @hits;
 402	my ($num_fields);
 403	my $skipdirlock;							# if true, don't write conv.out
 404										# used only for single file operations
 405										# at the moment
 406	my $cd;
 407
 408	my @filenames;
 409	# We may have recieved a single file name to process...
 410	if ( -d $dir )
 411		{
 412		# change into the directory to be processed
 413		# open the current directory for listing
 414		# initialize the list of filenames
 415		# and set filenames equal to directory listing
 416		unless ( ( chdir $dir ) and ( opendir CURDIR, "." ) and ( @filenames = readdir CURDIR ) )
 417			{
 418			$cd = cwd;
 419			error_count 'error', \$errors, "skipping directory $dir from $cd";
 420			chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
 421			return ($errors, $warnings);
 422			}
 423
 424		# clean up by closing the directory
 425		closedir(CURDIR);
 426		}
 427	elsif ( -f $dir ) # we recieved a single file
 428		{
 429		push @filenames, $dir;
 430		$skipdirlock = 1;
 431		}
 432	else
 433		{
 434		$cd = cwd;
 435		error_count 'error', \$errors, "no such directory/file $dir from $cd\n";
 436		# chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
 437		return ($errors, $warnings);
 438		}
 439
 440	# save the current directory
 441	$cd = cwd;
 442
 443	# increment the global $curlevel variable
 444	$curlevel = $curlevel +1;
 445
 446	# initialize a list for any subdirectories and any files
 447	# we need to process
 448	my $vcsdir = ""; 
 449	my (@subdirs, $fn, $file, @files, @pvcsarchives);
 450
 451	# print "$cd:  " . join (", ", @filenames) . "\n";
 452	# hit_any_key;
 453
 454	(@files, @pvcsarchives) = ( (), () );
 455	# begin a for loop to execute on each filename in the list @filename
 456	foreach $fn (@filenames)
 457		{
 458		# if the file is a directory...
 459		if (-d $fn)
 460			{
 461			# then if we are not expecting a flat arrangement of pvcs files
 462			# and we found a vcs directory add its files to @pvcsarchives
 463			if (!$options{'pvcs-dirs-flat'} and $fn =~ /^vcs$/i)
 464				{
 465				if ($options{verify} =~ /^locks$/ ) {
 466				if ( -f $donefile_name ) {
 467					print "Verified existence of lockfile $cd/$donefile_name."
 468							. ( ($options{mode} =~ /^convert$/) ? "  Skipping directory." : "" )
 469							. "\n" if ($options{verbose});
 470					next;
 471				} elsif ( $options{mode} =~ /^verify$/ ) {
 472					print "No lockfile found for $cd .\n";
 473					next;
 474				}
 475				}
 476
 477				# else add the files in the vcs dir to our list of files to process
 478				error_count 'warning', \$warnings, "Found two vcs dirs in directory $cd.\n"
 479						if ($vcsdir and $options{warnings});
 480
 481				$vcsdir = $fn;
 482
 483				unless ( ( opendir VCSDIR, $vcsdir ) and ( @files = readdir VCSDIR ) )
 484					{
 485					error_count 'error', \$errors, "skipping directory &cd/$fn";
 486					next;
 487					}
 488				closedir VCSDIR;
 489
 490				# and so we don't need to worry about where these
 491				# files came from later...
 492				foreach $file (@files)
 493					{
 494					push @pvcsarchives, "$vcsdir/$file" if (-f "$vcsdir/$file");
 495					}
 496
 497				# don't want recursion here...
 498				@pvcsarchives = grep !/^\.\.?$/, @pvcsarchives;
 499				}
 500			elsif ($fn !~ /^\.\.?$/)
 501				{
 502				next if (!$options{'rcs-dirs-flat'} and $fn =~ /^rcs$/i);
 503				# include it in @subdir if it's not a parent directory
 504				push(@subdirs,$fn);
 505				}
 506			}
 507		# else if we are processing a flat arrangement of pvcs files...
 508		elsif ($options{'pvcs-dirs-flat'} and -f $fn)
 509			{
 510			if ($options{verify} =~ /^locks$/) {
 511				if ( -f $donefile_name) {
 512					print "Found lockfile $cd/$donefile_name."
 513						. ( ($options{mode} =~ /^convert$/) ? "  Skipping directory." : "" )
 514						. "\n" if ($options{verbose});
 515					last;
 516				} elsif ($options{mode} =~ /^verify$/) {
 517					print "No lockfile found for $cd .\n";
 518					last;
 519				}
 520			}
 521			# else add this to the list of files to process
 522			push (@pvcsarchives, $fn);
 523			}
 524		}
 525
 526	# print "pvcsarchives:  " . join (", ", @pvcsarchives) . "\n";
 527	# print "subdirs:  " . join (", ", @subdirs) . "\n";
 528	# hit_any_key;
 529
 530	# for loop of subdirs
 531	foreach (@subdirs)
 532		{
 533		# run execdir on each sub dir
 534		if ($maxlevel >= $curlevel)
 535			{
 536			my ($e, $w) = execdir ($_);
 537			$errors += $e;
 538			$warnings += $w;
 539			}
 540		}
 541
 542	# Print output header for each directory
 543	print("Directory: $cd\n");
 544
 545	# the @files variable should already contain the list of files
 546	# we should attempt to process
 547	if ( @pvcsarchives && ( $options{mode} =~ /^convert$/ ) )
 548		{
 549		# create an RCS directory in parent to store RCS files in
 550		if ( !( $options{'rcs-dirs-flat'} or (-d "RCS") or mkpath ( "RCS" ) ) )
 551			{
 552 			error_count 'error', \$errors, "failed to make directory $cd/RCS - skipping directory $cd";
 553			@pvcsarchives = ();
 554			# after all, we have nowhere to put them...
 555			}
 556		}
 557
 558	# begin a for loop to execute on each filename in the list @files
 559	foreach $pvcsarchive (@pvcsarchives)
 560		{
 561		my $got_workfile = 0;
 562		my $got_version_labels = 0;
 563		my $got_description = 0;
 564		my $got_rev_count = 0;
 565
 566		my $abs_file = $cd . "/" . $pvcsarchive;
 567
 568		print("Verifying $abs_file...\n") if ($options{verbose});
 569
 570		print "vlog $pvcsarchive\n";
 571		my $vlog_output = `vlog $pvcsarchive`;
 572		$_ = $vlog_output;
 573
 574		# Split the vcs status output into individual lines
 575		my @vlog_strings = split /\n/;
 576		my $num_vlog_strings = @vlog_strings;
 577		$_ = $vlog_strings[0];
 578		if ( /^\s*$/ || /^vlog: warning/ )
 579			{
 580			error_count 'warning', \$warnings, "$abs_file is NOT a valid PVCS archive!!!\n";
 581			next;
 582			}
 583
 584		my $num;
 585		# Collect all vlog output into appropriate variables
 586		#
 587		# This will ignore at the very least the /^\s*Archive:\s*/ field
 588		# and maybe more.  This should not be a problem.
 589		for ( $num = 0; $num < $num_vlog_strings; $num++ )
 590			{
 591			# print("$vlog_strings[$num]\n");
 592			$_ = $vlog_strings[$num];
 593
 594			if( ( /^Workfile:\s*/ ) && (!$got_workfile ) )
 595				{
 596				my $num_fields;
 597
 598				$got_workfile = 1;
 599				# get the string to the right of the above search (with any path stripped)
 600				$workfile = $';
 601				$_ = $workfile;
 602				$num_fields = split /[\/\\]/;
 603				if ( $num_fields > 1 ) 
 604					{ 
 605					$workfile = $_[$num_fields - 1 ];
 606					}
 607
 608				$rcsarchive = $options{'rcs-dirs-flat'} ? "" : "RCS/";
 609				$rcsarchive .= $workfile;
 610				$rcsarchive .= $options{'rcs-extension'} if ($options{'rcs-extension'});
 611				print "Workfile is $workfile\n" if ($options{debug});
 612				}
 613
 614			elsif ( ( /^Rev count:\s*/ ) && (!$got_rev_count ) )
 615				{
 616				$got_rev_count = 1;
 617				# get the string to the right of the above search
 618				$rev_count = $';
 619				print "Revision count is $rev_count\n";
 620				}
 621
 622			elsif ( ( /^Version labels:\s*/ ) && (!$got_version_labels ) )
 623				{
 624				$got_version_labels = 1;
 625				$first_vl = $num+1;
 626				print "Version labels start at $first_vl\n" if ($options{debug});
 627				}
 628
 629			elsif ( ( /^Description:\s*/ ) && (!$got_description ) )
 630				{
 631				$got_description = 1;
 632				$description = "\"" . $vlog_strings[$num+1] . "\"";
 633				print "Description is $description\n" if ($options{debug});
 634				$last_vl = $num - 1;
 635				}
 636
 637			elsif ( /^Rev\s+/ ) # get all the revision information at once
 638				{
 639				$rev_index = 0;
 640				@rev_num = ();
 641				while ( $rev_index < $rev_count )
 642					{
 643					$_ = $vlog_strings[$num];
 644					/^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/;
 645					$rev_num[$rev_index] = $1;
 646					print "Found revision: $rev_num[$rev_index]\n" if ($options{debug});
 647					die "Not a valid revision ($rev_num[$rev_index]).\n"
 648						if ($rev_num[$rev_index] !~ /^(\d+\.)(\d+\.\d+\.)*\d+$/);
 649
 650					$_ = $vlog_strings[$num+1];
 651					/^\s*Locked\s*/ and $num++;
 652
 653					$_ = $vlog_strings[$num+1];
 654					/^\s*Checked in:\s*/;
 655					$checked_in{$rev_num[$rev_index]} = "\"" . $' . "\"";
 656					print "Checked in: $checked_in{$rev_num[$rev_index]}\n" if ($options{debug});
 657
 658					$_ = $vlog_strings[$num+3];
 659					/^\s*Author id:\s*/;
 660					split;
 661					$author{$rev_num[$rev_index]} = "\"" . $_[2] . "\"";
 662					print "Author: $author{$rev_num[$rev_index]}\n" if ($options{debug});
 663
 664					my @branches = ();
 665					$_ = $vlog_strings[$num+1];
 666					if (/^\s*Branches:\s*/)
 667						{ 
 668						$num++;
 669						@branches = split /\s+/, $';
 670						}
 671
 672					$relative_comment_index = 0;
 673					@comment_string = ();
 674 					while( ( ( $num + 4 + $relative_comment_index ) < @vlog_strings)
 675							&& ( $vlog_strings[$num+4+$relative_comment_index]
 676								!~ /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/ ) )
 677						{
 678						# We need the \n added for multi-line comments.  There is no effect for
 679						# single-line comments since RCS inserts the \n if it doesn't exist already
 680						# print "Found commment line: $vlog_strings[$num+4+$relative_comment_index]\n"
 681						#	if ($options{debug});
 682						push @comment_string, $vlog_strings[$num+4+$relative_comment_index], "\n";
 683						$relative_comment_index += 1;
 684						}
 685					# print "Popped from comment: " . join ("", splice (@comment_string, -2)) 
 686					#		. "\n"
 687					#	if ($options{debug});
 688					# Pop the "-+" or "=+" line from the comment
 689					while ( (pop @comment_string) !~ /^-{35}|={35}$/ )
 690						{}
 691					$comment{$rev_num[$rev_index]} = join "", @comment_string;
 692
 693					$num += ( 4 + $relative_comment_index );
 694					print "Got comment for $rev_num[$rev_index]\n" if ($options{debug});
 695					print "comment string: $comment{$rev_num[$rev_index]}\n" if ($options{debug});
 696					$rev_index += 1;
 697					} # while ( $rev_index < $rev_count )
 698				$num -= 1; #although there should be nothing left for this to matter
 699				} # Get Rev information
 700			} # for ($num = 0; $num < $num_vlog_strings; $num++)
 701		# hit_any_key if ($options{debug});
 702		# Create RCS revision numbers corresponding to PVCS version numbers
 703		foreach $revision (@rev_num)
 704			{
 705			$rcs_rev_num{ $revision } = &pvcs_to_rcs_rev_number( $revision );
 706			print"PVCS revision is $revision; RCS revision is $rcs_rev_num{ $revision }\n"
 707					if ($options{debug});
 708			}
 709
 710		# Sort the revision numbers - PVCS and RCS store them in different orders
 711		# Clear @_ so we don't pass anything in by accident...
 712		@_ = ();
 713		@rev_num = sort revisions @rev_num;
 714		print "Sorted rev_nums:\n" . join ("\n", @rev_num) . "\n" if ($options{debug});
 715		# hit_any_key;
 716
 717		# Loop through each version label, checking for need to relabel ' ' with '_'.
 718		$num_version_labels = $last_vl - $first_vl + 1;
 719		print "Version label count is $num_version_labels\n";
 720		for( $i = $first_vl; $i <= $last_vl; $i += 1 )
 721			{
 722			# print("$vlog_strings[$i]\n");
 723			$label_index = $i - $first_vl;
 724			$_=$vlog_strings[$i];
 725			print "Starting with string '$_'\n" if ($options{debug});
 726			split /\"/;
 727			$label = $_[1];
 728			print "Got label '$label'\n" if ($options{debug});
 729			split /\s+/, $_[2];
 730			$label_revision[$label_index] = $_[2];
 731			print "Original label is $label_revision[$label_index]\n" if ($options{debug});
 732
 733			# Create RCS revision numbers corresponding to PVCS version numbers by
 734			# adding 1 to the revision number (# after last .)
 735			$label_revision[ $label_index ] = pvcs_to_rcs_rev_number( $label_revision [ $label_index ] );
 736			# replace ' ' with '_', if needed
 737			$_=$label;
 738			$new_label[$label_index] = $label;
 739			$new_label[$label_index] =~ s/ /_/g;
 740			$new_label[$label_index] =~ s/\./_/g;
 741			$new_label[$label_index] = "\"" . $new_label[$label_index] . "\"";
 742			print"Label $new_label[$label_index] is for revision $label_revision[$label_index]\n" if ($options{debug});
 743			}
 744		
 745		##########
 746		#
 747		# See if the RCS archive is up to date with the PVCS archive
 748		#
 749		##########
 750		if ($options{verify} =~ /^locks|exists$/ and -f $rcsarchive)
 751			{
 752			print "Verified existence of $cd/$rcsarchive."
 753					. ( ($options{mode} =~ /^convert$/) ? "  Skipping." : "" )
 754					. "\n" if ($options{verbose});
 755			next;
 756			}
 757
 758		# Create RCS archive and check in all revisions, then label.
 759		my $first_time = 1;
 760		foreach $revision (@rev_num)
 761			{
 762			# print "get -p$revision $pvcsarchive >$workfile\n";
 763			print "get -r$revision $pvcsarchive\n";
 764			# $vcs_output = `vcs -u -r$revision $pvcsarchive`;
 765			# $get_output = `get -p$revision $pvcsarchive >$workfile`;
 766			$get_output = `get -r$revision $pvcsarchive`;
 767
 768			# if this is the first time, delete the rcs archive if it exists
 769			# need for $options{verify} == none
 770			unlink $rcsarchive if ($first_time and $options{verify} =~ /^none$/ and -f $rcsarchive);
 771
 772			# Also check here whether this file ought to be "binary"
 773			if ( $first_time )
 774				{
 775				$rcs_command = "$rcs_base_command -i";
 776				if ( ( @hits = grep { $workfile =~ /$_/ } keys %bin_ext ) || $options{'force-binary'} )
 777					{
 778					$rcs_command .= " -kb";
 779					$workfile =~ /$hits[0]/ if (@hits);
 780					print "Binary attribute -kb added ("
 781						. (@hits ? "file type is '$bin_ext{$hits[0]}' for extension '$&'" : "forced")
 782						. ")\n";
 783					}
 784				$first_time and $ci_command .= " -t-$description";
 785
 786				$rcs_command .= " $workfile";
 787
 788				# print and execute the rcs archive initialization command
 789				print "$rcs_command\n";
 790				$wtr = new IO::File "|$rcs_command";
 791				$wtr->print ($description);
 792				$wtr->print ("\n") unless ($description =~ /\n$/s);
 793				$wtr->print (".\n");
 794				$wtr->close;
 795
 796				# $rcs_output = `$rcs_base_command -i -kb $workfile`;
 797				}
 798
 799			# if this isn't the first time, we need to lock the rcs branch
 800			#
 801			# This is a little messy, but it works.  Some extra locking is attempted.
 802			# (This happens the first time a branch is used, at the least)
 803			my $branch = "";
 804			my @branch;
 805			@branch = split /\./, $rcs_rev_num{$revision};
 806			pop @branch;
 807			$branch = join ".", @branch;
 808
 809			$rcs_output = `$rcs_base_command -l$branch $workfile` if (!$first_time);
 810
 811			# If an empty comment is specified, RCS will not check in the file;
 812			# check for this case.	(but an empty -t- description is fine - go figure!)
 813			# Since RCS will pause and ask for a comment if one is not given,
 814			# substitute a dummy comment "no comment".
 815			$comment{$revision} =~ /^\s*$/ and $comment{$revision} = "no comment\n";
 816
 817			$ci_command = $ci_base_command;
 818			$ci_command .= " -f -r$rcs_rev_num{$revision} -d$checked_in{$revision}"
 819					. " -w$author{$revision}";
 820
 821			$ci_command .= " $workfile";
 822
 823			# print and execute the ci command
 824			print "$ci_command\n";
 825			$wtr = new IO::File "|$ci_command";
 826			$wtr->print ($comment{$revision});
 827			$wtr->print ("\n") unless ($comment{$revision} =~ /\n$/s);
 828			$wtr->print (".\n");
 829			$wtr->close;
 830			# $ci_output = `$ci_command`;
 831			# $ci_output = `cat $tmpdir/ci.out`;
 832
 833			$first_time = 0 if ($first_time);
 834			} # foreach revision
 835
 836		# Attach version labels
 837		for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 )
 838			{
 839			# print "rcs -x,v -n$new_label[$i]:$label_revision[$i] $workfile\n";
 840			$rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] $workfile`;
 841			print "Version label $new_label[$i] added to revision $label_revision[$i]\n";
 842			} # foreach label
 843
 844		# hit_any_key;
 845		} # foreach pvcs archive file
 846
 847	# We processed a vcs directory, so if there were any files, lock it.
 848	# We are guaranteed to have made the attempt at
 849	#
 850	# $skipdirlock gets set if a single file name was passed to this function to enable
 851	# a '$0 *' operation...
 852	if ( @pvcsarchives && !$skipdirlock)
 853		{
 854		my $fh = new IO::File ">>$donefile_name" or new IO::File ">$donefile_name";
 855		if ($fh)
 856			{
 857			$fh->close;
 858			}
 859		else
 860			{
 861			error_count 'error', \$errors, "couldn't create lockfile $cd/$donefile_name";
 862			}
 863		}
 864
 865	$curlevel = $curlevel - 1;
 866
 867	chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
 868	return ($errors, $warnings);
 869	}
 870
 871
 872
 873#
 874# This function effectively does a cmp between two revision numbers
 875# It is intended to be passed into Perl's sort routine.
 876#
 877# the pvcs_out is not implemented well.  It should probably be
 878# returnning $b[0] <=> $a[0] rather than $a[0] <=> $b[0]
 879#
 880# The @_ argument implementation was going to be used for revision
 881# comparison as an aid to remove the /^\sRev/ in revision comment
 882# error.  The effort was fruitless at the time.
 883sub revisions
 884	{
 885	my @a = split /\./, (defined $a) ? $a : shift;
 886	my @b = split /\./, (defined $b) ? $b : shift;
 887	my $function = @_ ? shift : 'rcs_in';
 888	my ($i, $ret_val);
 889
 890	die "Not enough arguments to revisions : a = ", join (".", @a),
 891			"; b = ", join (".", @b), ", stopped"
 892		unless (@a and @b);
 893
 894	for ($i = 0; $i < scalar( @a ) && $i < scalar( @b ); $i++)
 895		{
 896		$a[$i] == $b[$i] or return ($a[$i] <=> $b[$i]);
 897		}
 898
 899	return 0 if (scalar (@a) == scalar (@b));
 900
 901	if ($function eq 'rcs_in')
 902		{
 903		return (($i == @b) || -1);
 904		}
 905	elsif ($function eq 'pvcs_out')
 906		{
 907		return (($i == @a) || -1);
 908		}
 909	else
 910		{
 911		die "error - Invalid function type passed to revisions ($function)", ", stopped";
 912		}
 913	}
 914
 915
 916
 917sub pvcs_to_rcs_rev_number
 918	{
 919	my($input, $num_fields, @rev_string, $return_rev_num, $i);
 920
 921	$input = $_[0];
 922	$_ = $input;
 923	$num_fields = split /\./;
 924	@rev_string = @_;
 925	# @rev_string[$num_fields-1] += 1;
 926
 927	for( $i = 1; $i < $num_fields; $i += 1 )
 928		{
 929		if ( $i % 2 )
 930			{
 931			# DRP: 10/1
 932			# RCS does not allow revision zero
 933			$rev_string[ $i ] += 1;
 934			}
 935		elsif ( $i )
 936			{
 937			# DRP: 10/1
 938			# Branches must have even references for compatibility
 939			# with CVS's magic branch numbers.
 940			# (Indexes 2, 4, 6...)
 941			$rev_string[ $i ] *= 2;
 942			}
 943		}
 944
 945	# If this is a branch revision # (PVCS: a.b.c.*) then we want the CVS
 946	# revision # instead.  It's okay to do this conversion here since we
 947	# never commit to branches.  We'll only get a PVCS revision # in that
 948	# form when looking through the revision labels.
 949	if ($input =~ /\*$/)
 950		{
 951		pop @rev_string;
 952		push @rev_string, splice (@rev_string, -1, 1, "0");
 953		}
 954
 955	$return_rev_num = join ".", @rev_string;
 956	return $return_rev_num;
 957	}
 958
 959
 960
 961
 962
 963###
 964###
 965###
 966###
 967###
 968###   MAIN program: checks to see if there are command line parameters
 969###
 970###
 971###
 972###
 973###
 974
 975
 976
 977
 978	
 979# and read the options
 980die $usage unless GetOptions (\%options, "h|help" => \&exit_help, 
 981		"recurse!", "mode|m=s", "errorfiles!", "l", "rcs-dirs|rcs-directories|r=s",
 982		"pvcs-dirs|pvcs-directories|p=s", "test-binaries|t!",
 983		"rcs-extension=s", "verify|v=s", "vcsid|i=s", "verbose!", "debug!",
 984		"force-binary!", "cvs-branch-labels!", "warnings|w!");
 985
 986
 987
 988#
 989# Special processing for -l !^#%$^@#$%#$
 990#
 991# At the moment, -l overrides --recurse, regardless of the order the
 992# options were passed in
 993#
 994$options{recurse} = 0 if defined $options{l};
 995delete $options{l};
 996
 997
 998
 999# Make sure we got acceptable values for rcs-dirs and pvcs-dirs
1000my @hits = grep /^$options{'rcs-dirs'}/i, ("leaf", "flat");
1001@hits == 1 or die
1002		  "$0: $options{'rcs-dirs'} invalid argument to --rcs-dirs or ambiguous\n"
1003		. "    abbreviation.\n"
1004		. "    Must be one of: 'leaf' or 'flat'.\n"
1005		. $usage;
1006$options{'rcs-dirs'} = $hits[0];
1007$options{'rcs-dirs-flat'} = ($options{'rcs-dirs'} =~ /flat/);
1008delete $options{'rcs-dirs'};
1009
1010@hits = grep /^$options{'pvcs-dirs'}/i, ("leaf", "flat");
1011@hits == 1 or die
1012		  "$0: $options{'pvcs-dirs'} invalid argument to --pvcs-dirs or ambiguous\n"
1013		. "    abbreviation.\n"
1014		. "    Must be one of: 'leaf' or 'flat'.\n"
1015		. $usage;
1016$options{'pvcs-dirs'} = $hits[0];
1017$options{'pvcs-dirs-flat'} = ($options{'pvcs-dirs'} =~ /flat/);
1018delete $options{'pvcs-dirs'};
1019
1020# and for verify
1021@hits = grep /^$options{verify}/i, ("none", "locks", "exists", "lockdates", "revs", "full");
1022@hits == 1 or die
1023		  "$0: $options{verify} invalid argument to --verify or ambiguous\n"
1024		. "    abbreviation.\n"
1025		. "    Must be one of: 'none', 'locks', 'exists', 'lockdates', 'revs',\n"
1026		. "    or 'full'.\n"
1027		. $usage;
1028$options{verify} = $hits[0];
1029$options{verify} =~ /^none|locks|exists$/ or die
1030		  "$0: --verify=$options{verify} unimplemented.\n"
1031		. $usage;
1032
1033# and mode
1034@hits = grep /^$options{mode}/i, ("convert", "verify");
1035@hits == 1 or die
1036		  "$0: $options{mode} invalid argument to --mode or ambiguous abbreviation.\n"
1037		. "    Must be 'convert' or 'verify'.\n"
1038		. $usage;
1039$options{mode} = $hits[0];
1040
1041$options{'cvs-branch-labels'} or die
1042		  "$0: RCS Branch Labels unimplemented.\n"
1043		. $usage;
1044
1045# export VCSID into th environment for ourselves and our children
1046$ENV{VCSID} = $options{vcsid};
1047
1048
1049
1050#
1051# Verify we have all the binary executables we need to run this script
1052#
1053# Allowed this feature to be disabled in case which is missing or we are
1054# running on a system which does not return error codes properly (e.g. WIN95)
1055#
1056#      -- i.e. I don't feel like grepping output yet. --
1057#
1058my @missing_binaries = ();
1059if ($options{'test-binaries'})
1060	{
1061	foreach (@bin_dependancies)
1062		{
1063		if (system "which", $_)
1064			{
1065			push @missing_binaries, $_;
1066			}
1067		}
1068
1069	if (scalar @missing_binaries)
1070		{
1071		print STDERR "The following executables were not found in your PATH: "
1072			. join ( " ", @missing_binaries )
1073			. "\n"
1074			. "You must correct this before continuing.\n";
1075		exit 1;
1076		}
1077	}
1078delete $options{'test-binaries'};
1079
1080
1081
1082#
1083# set up our base archive manipulation commands
1084#
1085
1086# set up our rcs_command mods
1087$rcs_base_command = "rcs";
1088$rcs_base_command .= " -x$options{'rcs-extension'}" if ($options{'rcs-extension'});
1089
1090# set up our rcs_command mods
1091$ci_base_command = "ci";
1092$ci_base_command .= " -x$options{'rcs-extension'}" if ($options{'rcs-extension'});
1093
1094
1095
1096#
1097# So our logs fill in a manner we can monitor with 'tail -f' fairly easily:
1098#
1099STDERR->autoflush (1);
1100STDOUT->autoflush (1);
1101
1102
1103
1104# Initialize the globals we use to keep track of recursion
1105if ($options{recurse})
1106	{
1107	$maxlevel = 10000;		# Arbitrary recursion limit
1108	}
1109else
1110	{
1111	$maxlevel = 1;
1112	}
1113delete $options{recurse};
1114
1115# So we can lock the directories behind us
1116$donefile_name = $options{'rcs-dirs-flat'} ? "" : "RCS/";
1117$errorfile_name = $donefile_name . "#conv.errors";
1118$donefile_name .= "#conv.done";
1119
1120
1121
1122#
1123# start the whole thing and drop the return code on exit
1124#
1125push (@ARGV, ".") unless (@ARGV);
1126while ($_ = shift)
1127	{
1128	# reset the recursion level (corresponds to directory depth)
1129	# level 0 is the first directory we enter...
1130	$curlevel = -1;
1131	my ($e, $w) = execdir($_);
1132	$errors += $e;
1133	$warnings += $w;
1134	}
1135
1136
1137
1138print STDERR "$0:  " . ($errors ? "Aborted" : "Done") . ".\n";
1139print STDERR "$0:  ";
1140print STDERR ($errors ? $errors : "No") . " error" . (($errors != 1) ? "s" : "");
1141print STDERR ", " . ($warnings ? $warnings : "no") . " warning" . (($warnings != 1) ? "s" : "")
1142		if ($options{warnings});
1143print STDERR ".\n";
1144
1145
1146
1147#
1148# Woo-hoo!  We made it!
1149#
1150exit $errors;