/contrib/cvs/contrib/pvcs2rcs.in
Autoconf | 1150 lines | 689 code | 162 blank | 299 comment | 102 complexity | acc28f60307d9787e26ef68d35dd6ea5 MD5 | raw file
Possible License(s): MPL-2.0-no-copyleft-exception, BSD-3-Clause, LGPL-2.0, LGPL-2.1, BSD-2-Clause, 0BSD, JSON, AGPL-1.0, GPL-2.0
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;