2 # ---------------------------------
\r
3 # This program is free software; you can redistribute it and/or modify
\r
4 # it under the terms of the GNU General Public License as published by
\r
5 # the Free Software Foundation; either version 2, or (at your option)
\r
8 # This program is distributed in the hope that it will be useful,
\r
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
\r
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\r
11 # GNU General Public License for more details.
\r
13 ###########################################################################
\r
15 # To recursively walk through a PVCS archive directory tree (archives
\r
16 # located in VCS/ or vcs/ subdirectories) and convert them to RCS archives.
\r
17 # The RCS archive name is the PVCS workfile name with ",v" appended.
\r
20 # pvcs_to_rcs.pl --help
\r
22 # where -l indicates the operation is to be performed only in the current
\r
23 # directory (no recursion)
\r
27 # Would walk through every VCS or vcs subdir starting at the current directory,
\r
28 # and produce corresponding RCS archives one level above the VCS or vcs subdir.
\r
32 # * This script performs little error checking and logging
\r
33 # (i.e. USE AT YOUR OWN RISK)
\r
34 # * This script was last tested using ActiveState's port of Perl 5.005_02
\r
35 # (internalcut #507) under Win95, though it does compile under Perl-5.00404
\r
36 # for Solaris 2.4 run on a Solaris 2.6 system. The script crashed
\r
37 # occasionally under ActiveState's port of Perl 5.003_07 but this stopped
\r
38 # happening with the update so if you are having problems, try updating Perl.
\r
39 # Upgrading to cut #507 also seemed to coincide with a large speed
\r
40 # improvement, so try and keep up, hey? :) It was executed from MKS's
\r
41 # UNIX tools version 6.1 for Win32's sh. ALWAYS redirect your output to
\r
43 # * PVCS archives are left intact
\r
44 # * RCS archives are created in VCS/../RCS/ (or ./RCS using '-pflat')
\r
45 # * Branch labels in this script will be attached to the CVS magic
\r
46 # revision number. For branch a.b.c of a particular file, this means
\r
47 # the label will be attached to revision a.b.0.c of the converted
\r
48 # file. If you use the TrunkTip (1.*) label, be aware that it will convert
\r
49 # to RCS revision 0.1, which is useless to RCS and CVS. You'll probably
\r
50 # have to delete these.
\r
51 # * All revisions are saved with correct "metadata" (i.e. check-in date,
\r
52 # author, and log message). Any blank log message is replaced with
\r
53 # "no comment". This is because RCS does not allow non-interactive
\r
54 # check in of a new revision without a comment string.
\r
55 # * Revision numbers are incremented by 1 during the conversion (since
\r
56 # RCS does not allow revision 1.0).
\r
57 # * All converted branch numbers are even (the CVS paradigm)
\r
58 # * Version labels are assigned to the appropriate (incremented) revision
\r
59 # numbers. PVCS allows spaces and periods in version labels while RCS
\r
60 # does not. A global search and replace converts " " and "." to "_"
\r
61 # There may be other cases that ought to be added.
\r
62 # * Any working (checked-out) copies of PVCS archives
\r
63 # within the VCS/../ or vcs/../ (or possibly ./ with '-pflat')
\r
64 # will be deleted (or overwritten) depending on your mode of
\r
65 # operation since the current ./ is used in the checkout of each revision.
\r
66 # I suppose if development continues these files could be redirected to
\r
67 # temp space rather than ./ .
\r
68 # * Locks on PVCS archives should be removed (or the workfiles should be
\r
69 # checked-in) prior to conversion, although the script will blaze through
\r
70 # the archive nonetheless (But you would lose any checked out revision(s))
\r
71 # * The -kb option is added to the RCS archive for workfiles with the following
\r
72 # extensions: .bin .out .btl .rom .a07 .lib .exe .tco .obj .t8u .c8u .o .lku
\r
73 # .a and a few others. The %bin_ext variable holds these values in regexp
\r
75 # * the --force-binary option can be used to convert binary files which don't
\r
76 # have proper extensions, but I'd *probably* edit the %bin_ext variable.
\r
77 # * This script will abort occasionally with the error "invalid revision
\r
78 # number". This is known to happen when a revision comment has
\r
79 # /^\s*Rev/ (Perl regexp notation) in it. Fix the comment and start over.
\r
80 # (The directory locks and existance checking make this a fairly quick
\r
82 # * This script writes lockfiles in the RCS/ directories. It will also not
\r
83 # convert an archive if it finds the RCS Archive existant in the RCS/
\r
84 # directory. This enables the conversion to quickly pick up where it left
\r
85 # off after errors or interrupts occur. If you interrupt the script make
\r
86 # sure you delete the last RCS Archive File which was being written.
\r
87 # If you recieve the "Invalid revision number" error, then the RCS archive
\r
88 # file for that particular PVCS file will not have been created yet.
\r
89 # * This script will not create lockfiles when processing single
\r
90 # filenames passed into the script, for hopefully obvious reasons.
\r
91 # (lockfiles lock directories - DRP)
\r
92 # * Log the output to a file. That makes it real easy to grep for errors
\r
93 # later. (grep for "^[ \t]*(rcs|ci):" and be aware I might have missed
\r
94 # a few cases (get? vcs?) !!!) *** Also note that this script will
\r
95 # exibit some harmless RCS errors. Namely, it will attempt to lock
\r
96 # branches which haven't been created yet. ***
\r
97 # * I tried to keep the error and warning info up to date, but it seems
\r
98 # to mean very little. This script almost always exits with a warning
\r
99 # or an error that didn't seem to cause any harm. I didn't trace it
\r
100 # and our imported source checks out and builds...
\r
101 # It is probably happening when trying to convert empty directories
\r
102 # or read files (possibly checked out workfiles ) which are not
\r
104 # * You must use the -pflat option when processing single filenames
\r
105 # passed as arguments to the script. This is probably a bug.
\r
106 # * questions, comments, additions can be sent to info-cvs@nongnu.org
\r
107 #########################################################################
\r
112 # USER Configurables
\r
115 # %bin_ext should be editable from the command line.
\r
117 # NOTE: Each possible binary extension is listed as a Perl regexp
\r
119 # The value associated with each regexp key is used to print a log
\r
120 # message when a binary file is found.
\r
123 '\.(?i)bin$' => "Binary",
\r
124 '\.(?i)out$' => "Default Compiler Output",
\r
125 '\.(?i)btl$' => "",
\r
126 '\.(?i)rom$' => "",
\r
127 '\.(?i)a07$' => "",
\r
128 '\.(?i)lib$' => "DOS/Wintel/Netware Compiler Library",
\r
129 '\.(?i)lif$' => "Netware Binary File",
\r
130 '\.(?i)exe$' => "DOS/Wintel Executable",
\r
131 '\.(?i)tco$' => "",
\r
132 '\.(?i)obj$' => "DOS/Wintel Compiler Object",
\r
133 '\.(?i)res$' => "DOS/Wintel Resource File",
\r
134 '\.(?i)ico$' => "DOS/Wintel Icon File",
\r
135 '\.(?i)nlm$' => "Netware Loadable Module",
\r
136 '\.(?i)t8u$' => "",
\r
137 '\.(?i)c8u$' => "",
\r
138 '\.(?i)lku$' => "",
\r
139 '\.(?i)(bmp|gif|jpg|jpeg|jfif|tif|tiff|xbm)$' => "Image",
\r
140 '\.(?i)dll$' => "DOS/Wintel Dynamically Linked Library",
\r
141 '\.o$' => "UNIX Compiler Object",
\r
142 '\.a$' => "UNIX Compiler Library",
\r
143 '\.so(\.\d+\.\d+)?$' => "UNIX Shared Library"
\r
146 # The binaries this script is dependant on:
\r
147 my @bin_dependancies = ("vcs", "vlog", "rcs", "ci");
\r
149 # Where we should put temporary files
\r
150 my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/var/tmp";
\r
159 $Getopt::Long::bundling = 1;
\r
160 # $Getopt::Long::ignorecase = 0;
\r
164 $0 [-lt] [-i vcsid] [-r flat|leaf] [-p flat|leaf] [-x rcs_extension]
\r
165 [-v none|locks|exists] [options] [path...]
\r
170 ---------------------------- -----------------------------------
\r
171 -h | --Help Print this text
\r
174 ---------------------------- -----------------------------------
\r
175 --Recurse Recurse through directories
\r
177 -l | --NORecurse Process only .
\r
178 --Errorfiles Save a count of conversion errors
\r
179 in the RCS archive directory
\r
180 (default) (unimplemented)
\r
181 --NOErrorfiles Don't save a count of conversion
\r
182 errors (unimplemented)
\r
183 ( -m | --Mode ) Convert Convert PVCS files to RCS files
\r
185 ( -m | --Mode ) Verify Perform verification ONLY (unimplemented)
\r
186 ( -v | --VERIfy ) None Always replace existing RCS files
\r
187 ( -v | --VERIfy ) LOCKS Same as exists unless a #conv.done
\r
188 file exists in the RCS directory.
\r
189 In that case, only the #conv.done
\r
190 file's existance is verified for
\r
191 that directory. (default)
\r
192 ( -v | --VERIfy ) Exists Don't replace existing RCS files
\r
193 ( -v | --VERIfy ) LOCKDates Verify that an existing RCS file's
\r
194 last modification date is older
\r
195 than that of the lockfile
\r
197 ( -v | --VERIfy ) Revs Verify that the PVCS archive files
\r
198 and RCS archive file contain the
\r
199 same number of corresponding
\r
200 revisions. Add only new revisions
\r
201 to the RCS file. (unimplemented)
\r
202 ( -v | --VERIfy ) Full Perform --verify=Revs and confirm
\r
203 that the text of the revisions is
\r
204 identical. Add only new revisions
\r
205 unless an error is found. Then
\r
206 erase the RCS archive and recreate
\r
207 it. (unimplemented)
\r
208 -t | --Test-binaries Use 'which' to check \$PATH for
\r
209 the binaries required by this
\r
211 --NOTest-binaries Don't check for binaries
\r
212 --VERBose Enable verbose output
\r
213 --NOVerbose Disable verbose output (default)
\r
214 -w | --Warnings Print warning messages (default)
\r
215 --NOWarnings Don't print warning messages
\r
218 ---------------------------- -----------------------------------
\r
219 ( -r | --RCS-Dirs ) leaf RCS files stored in ./RCS (default)
\r
220 ( -r | --RCS-Dirs ) flat RCS files stored in .
\r
222 ( -x | --RCS-Extension ) Set RCS file extension
\r
224 --Force-binary Pass '-kb' to 'rcs -i' regardless of
\r
226 --NOForce-binary Only use '-kb' when the file has
\r
227 a binary extension (default)
\r
228 --Cvs-branch-labels Use CVS magic branch revision
\r
229 numbers when attaching branch
\r
231 --NOCvs-branch-labels Attach branch labels to RCS branch
\r
232 revision numbers (unimplemented)
\r
235 ---------------------------- -----------------------------------
\r
236 ( -p | --Pvcs-dirs ) leaf PVCS files expected in ./VCS
\r
238 ( -p | --Pvcs-dirs ) flat PVCS files expected in .
\r
239 ( -i | --VCsid ) vcsid Use vcsid instead of \$VCSID
\r
241 --------------------------------------------------------------------------
\r
242 The optional path argument should contain the name of a file or directory
\r
243 to convert. If not given, it will default to '.'.
\r
244 --------------------------------------------------------------------------
\r
250 # Initialize globals
\r
253 my ($errors, $warnings) = (0, 0);
\r
254 my ($curlevel, $maxlevel);
\r
255 my ($rcs_base_command, $ci_base_command);
\r
256 my ($donefile_name, $errorfile_name);
\r
258 # set up the default options
\r
263 'rcs-dirs' => "leaf",
\r
264 'rcs-extension' => ",v",
\r
265 'force-binary' => 0,
\r
266 'cvs-branch-labels' => 1,
\r
267 'pvcs-dirs' => "leaf",
\r
269 'test-binaries' => 1,
\r
270 vcsid => $ENV{VCSID} || "",
\r
278 # This is untested except under Solaris 2.4 or 2.6 and
\r
279 # may not be portable
\r
281 # I think the readline lib or some such has an interface
\r
282 # which may enable this now. The perl installer sure looks
\r
283 # like it's testing this kind of thing, anyhow.
\r
287 system "stty", "-icanon", "min", "1";
\r
289 print "Hit any key to continue...";
\r
292 system "stty", "icanon", "min", "0";
\r
293 STDOUT->autoflush (0);
\r
295 print "\nI always wondered where that key was...\n";
\r
306 my $fdn = $fh ? $fh : "STDERR";
\r
307 $fh = new IO::File;
\r
308 $fh->fdopen ($fdn, "w");
\r
311 $fh->print ($usage);
\r
320 my $fdn = $fh ? $fh : "STDOUT";
\r
321 $fh = new IO::File;
\r
322 $fh->fdopen ($fdn, "w");
\r
325 $fh->print ($help);
\r
328 # print the help and exit $_[0] || 0
\r
337 my $type = shift or die "$0: error - error_count usage: error_count type [, ref] [, LIST]\n";
\r
338 my $error_count_ref;
\r
341 if (ref ($_[0]) && ref ($_[0]) == "SCALAR")
\r
343 $error_count_ref = shift;
\r
347 $error_count_ref = \$errors;
\r
349 $$error_count_ref++;
\r
351 push @_, "something wrong.\n" unless ( @_ > 0 );
\r
353 $outstring = sprintf "$0: $type - " . join ("", @_);
\r
354 $outstring .= sprintf " - $!\n" unless ($outstring =~ /\n$/);
\r
356 print STDERR $outstring;
\r
358 if ($options{errorfiles})
\r
360 my $fh = new IO::File ">>$errorfile_name" or new IO::File ">$errorfile_name";
\r
363 $fh->print ($$error_count_ref . "\n");
\r
364 $fh->print ($outstring);
\r
370 print STDERR "$0: error - failed to open errorfile $cd/$errorfile_name - $!\n"
\r
371 if ($options{debug});
\r
375 return $$error_count_ref;
\r
380 # the main procedure that is run once in each directory
\r
384 my ($errors, $warnings) = (0, 0); # We return these error counters
\r
389 my $i; # Generic counter
\r
390 my ($pvcsarchive, $workfile, $rcsarchive); # .??v, checked out file, and ,v files,
\r
392 my ($rev_count, $first_vl, $last_vl, $description,
\r
393 $rev_index, @rev_num, %checked_in, %author,
\r
394 $relative_comment_index, @comment_string,
\r
396 my ($num_version_labels, $label_index, @label_revision, $label,
\r
397 @new_label, $rcs_rev);
\r
398 my ($revision, %rcs_rev_num);
\r
399 my ($get_output, $rcs_output, $ci_output, $mv_output);
\r
400 my ($ci_command, $rcs_command, $wtr);
\r
403 my $skipdirlock; # if true, don't write conv.out
\r
404 # used only for single file operations
\r
409 # We may have recieved a single file name to process...
\r
412 # change into the directory to be processed
\r
413 # open the current directory for listing
\r
414 # initialize the list of filenames
\r
415 # and set filenames equal to directory listing
\r
416 unless ( ( chdir $dir ) and ( opendir CURDIR, "." ) and ( @filenames = readdir CURDIR ) )
\r
419 error_count 'error', \$errors, "skipping directory $dir from $cd";
\r
420 chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
\r
421 return ($errors, $warnings);
\r
424 # clean up by closing the directory
\r
427 elsif ( -f $dir ) # we recieved a single file
\r
429 push @filenames, $dir;
\r
435 error_count 'error', \$errors, "no such directory/file $dir from $cd\n";
\r
436 # chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
\r
437 return ($errors, $warnings);
\r
440 # save the current directory
\r
443 # increment the global $curlevel variable
\r
444 $curlevel = $curlevel +1;
\r
446 # initialize a list for any subdirectories and any files
\r
447 # we need to process
\r
449 my (@subdirs, $fn, $file, @files, @pvcsarchives);
\r
451 # print "$cd: " . join (", ", @filenames) . "\n";
\r
454 (@files, @pvcsarchives) = ( (), () );
\r
455 # begin a for loop to execute on each filename in the list @filename
\r
456 foreach $fn (@filenames)
\r
458 # if the file is a directory...
\r
461 # then if we are not expecting a flat arrangement of pvcs files
\r
462 # and we found a vcs directory add its files to @pvcsarchives
\r
463 if (!$options{'pvcs-dirs-flat'} and $fn =~ /^vcs$/i)
\r
465 if ($options{verify} =~ /^locks$/ ) {
\r
466 if ( -f $donefile_name ) {
\r
467 print "Verified existence of lockfile $cd/$donefile_name."
\r
468 . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" )
\r
469 . "\n" if ($options{verbose});
\r
471 } elsif ( $options{mode} =~ /^verify$/ ) {
\r
472 print "No lockfile found for $cd .\n";
\r
477 # else add the files in the vcs dir to our list of files to process
\r
478 error_count 'warning', \$warnings, "Found two vcs dirs in directory $cd.\n"
\r
479 if ($vcsdir and $options{warnings});
\r
483 unless ( ( opendir VCSDIR, $vcsdir ) and ( @files = readdir VCSDIR ) )
\r
485 error_count 'error', \$errors, "skipping directory &cd/$fn";
\r
490 # and so we don't need to worry about where these
\r
491 # files came from later...
\r
492 foreach $file (@files)
\r
494 push @pvcsarchives, "$vcsdir/$file" if (-f "$vcsdir/$file");
\r
497 # don't want recursion here...
\r
498 @pvcsarchives = grep !/^\.\.?$/, @pvcsarchives;
\r
500 elsif ($fn !~ /^\.\.?$/)
\r
502 next if (!$options{'rcs-dirs-flat'} and $fn =~ /^rcs$/i);
\r
503 # include it in @subdir if it's not a parent directory
\r
504 push(@subdirs,$fn);
\r
507 # else if we are processing a flat arrangement of pvcs files...
\r
508 elsif ($options{'pvcs-dirs-flat'} and -f $fn)
\r
510 if ($options{verify} =~ /^locks$/) {
\r
511 if ( -f $donefile_name) {
\r
512 print "Found lockfile $cd/$donefile_name."
\r
513 . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" )
\r
514 . "\n" if ($options{verbose});
\r
516 } elsif ($options{mode} =~ /^verify$/) {
\r
517 print "No lockfile found for $cd .\n";
\r
521 # else add this to the list of files to process
\r
522 push (@pvcsarchives, $fn);
\r
526 # print "pvcsarchives: " . join (", ", @pvcsarchives) . "\n";
\r
527 # print "subdirs: " . join (", ", @subdirs) . "\n";
\r
530 # for loop of subdirs
\r
533 # run execdir on each sub dir
\r
534 if ($maxlevel >= $curlevel)
\r
536 my ($e, $w) = execdir ($_);
\r
542 # Print output header for each directory
\r
543 print("Directory: $cd\n");
\r
545 # the @files variable should already contain the list of files
\r
546 # we should attempt to process
\r
547 if ( @pvcsarchives && ( $options{mode} =~ /^convert$/ ) )
\r
549 # create an RCS directory in parent to store RCS files in
\r
550 if ( !( $options{'rcs-dirs-flat'} or (-d "RCS") or mkpath ( "RCS" ) ) )
\r
552 error_count 'error', \$errors, "failed to make directory $cd/RCS - skipping directory $cd";
\r
553 @pvcsarchives = ();
\r
554 # after all, we have nowhere to put them...
\r
558 # begin a for loop to execute on each filename in the list @files
\r
559 foreach $pvcsarchive (@pvcsarchives)
\r
561 my $got_workfile = 0;
\r
562 my $got_version_labels = 0;
\r
563 my $got_description = 0;
\r
564 my $got_rev_count = 0;
\r
566 my $abs_file = $cd . "/" . $pvcsarchive;
\r
568 print("Verifying $abs_file...\n") if ($options{verbose});
\r
570 print "vlog $pvcsarchive\n";
\r
571 my $vlog_output = `vlog $pvcsarchive`;
\r
574 # Split the vcs status output into individual lines
\r
575 my @vlog_strings = split /\n/;
\r
576 my $num_vlog_strings = @vlog_strings;
\r
577 $_ = $vlog_strings[0];
\r
578 if ( /^\s*$/ || /^vlog: warning/ )
\r
580 error_count 'warning', \$warnings, "$abs_file is NOT a valid PVCS archive!!!\n";
\r
585 # Collect all vlog output into appropriate variables
\r
587 # This will ignore at the very least the /^\s*Archive:\s*/ field
\r
588 # and maybe more. This should not be a problem.
\r
589 for ( $num = 0; $num < $num_vlog_strings; $num++ )
\r
591 # print("$vlog_strings[$num]\n");
\r
592 $_ = $vlog_strings[$num];
\r
594 if( ( /^Workfile:\s*/ ) && (!$got_workfile ) )
\r
599 # get the string to the right of the above search (with any path stripped)
\r
602 $num_fields = split /[\/\\]/;
\r
603 if ( $num_fields > 1 )
\r
605 $workfile = $_[$num_fields - 1 ];
\r
608 $rcsarchive = $options{'rcs-dirs-flat'} ? "" : "RCS/";
\r
609 $rcsarchive .= $workfile;
\r
610 $rcsarchive .= $options{'rcs-extension'} if ($options{'rcs-extension'});
\r
611 print "Workfile is $workfile\n" if ($options{debug});
\r
614 elsif ( ( /^Rev count:\s*/ ) && (!$got_rev_count ) )
\r
616 $got_rev_count = 1;
\r
617 # get the string to the right of the above search
\r
619 print "Revision count is $rev_count\n";
\r
622 elsif ( ( /^Version labels:\s*/ ) && (!$got_version_labels ) )
\r
624 $got_version_labels = 1;
\r
625 $first_vl = $num+1;
\r
626 print "Version labels start at $first_vl\n" if ($options{debug});
\r
629 elsif ( ( /^Description:\s*/ ) && (!$got_description ) )
\r
631 $got_description = 1;
\r
632 $description = "\"" . $vlog_strings[$num+1] . "\"";
\r
633 print "Description is $description\n" if ($options{debug});
\r
634 $last_vl = $num - 1;
\r
637 elsif ( /^Rev\s+/ ) # get all the revision information at once
\r
641 while ( $rev_index < $rev_count )
\r
643 $_ = $vlog_strings[$num];
\r
644 /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/;
\r
645 $rev_num[$rev_index] = $1;
\r
646 print "Found revision: $rev_num[$rev_index]\n" if ($options{debug});
\r
647 die "Not a valid revision ($rev_num[$rev_index]).\n"
\r
648 if ($rev_num[$rev_index] !~ /^(\d+\.)(\d+\.\d+\.)*\d+$/);
\r
650 $_ = $vlog_strings[$num+1];
\r
651 /^\s*Locked\s*/ and $num++;
\r
653 $_ = $vlog_strings[$num+1];
\r
654 /^\s*Checked in:\s*/;
\r
655 $checked_in{$rev_num[$rev_index]} = "\"" . $' . "\"";
\r
656 print "Checked in: $checked_in{$rev_num[$rev_index]}\n" if ($options{debug});
\r
658 $_ = $vlog_strings[$num+3];
\r
659 /^\s*Author id:\s*/;
\r
661 $author{$rev_num[$rev_index]} = "\"" . $_[2] . "\"";
\r
662 print "Author: $author{$rev_num[$rev_index]}\n" if ($options{debug});
\r
665 $_ = $vlog_strings[$num+1];
\r
666 if (/^\s*Branches:\s*/)
\r
669 @branches = split /\s+/, $';
\r
672 $relative_comment_index = 0;
\r
673 @comment_string = ();
\r
674 while( ( ( $num + 4 + $relative_comment_index ) < @vlog_strings)
\r
675 && ( $vlog_strings[$num+4+$relative_comment_index]
\r
676 !~ /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/ ) )
\r
678 # We need the \n added for multi-line comments. There is no effect for
\r
679 # single-line comments since RCS inserts the \n if it doesn't exist already
\r
680 # print "Found commment line: $vlog_strings[$num+4+$relative_comment_index]\n"
\r
681 # if ($options{debug});
\r
682 push @comment_string, $vlog_strings[$num+4+$relative_comment_index], "\n";
\r
683 $relative_comment_index += 1;
\r
685 # print "Popped from comment: " . join ("", splice (@comment_string, -2))
\r
687 # if ($options{debug});
\r
688 # Pop the "-+" or "=+" line from the comment
\r
689 while ( (pop @comment_string) !~ /^-{35}|={35}$/ )
\r
691 $comment{$rev_num[$rev_index]} = join "", @comment_string;
\r
693 $num += ( 4 + $relative_comment_index );
\r
694 print "Got comment for $rev_num[$rev_index]\n" if ($options{debug});
\r
695 print "comment string: $comment{$rev_num[$rev_index]}\n" if ($options{debug});
\r
697 } # while ( $rev_index < $rev_count )
\r
698 $num -= 1; #although there should be nothing left for this to matter
\r
699 } # Get Rev information
\r
700 } # for ($num = 0; $num < $num_vlog_strings; $num++)
\r
701 # hit_any_key if ($options{debug});
\r
702 # Create RCS revision numbers corresponding to PVCS version numbers
\r
703 foreach $revision (@rev_num)
\r
705 $rcs_rev_num{ $revision } = &pvcs_to_rcs_rev_number( $revision );
\r
706 print"PVCS revision is $revision; RCS revision is $rcs_rev_num{ $revision }\n"
\r
707 if ($options{debug});
\r
710 # Sort the revision numbers - PVCS and RCS store them in different orders
\r
711 # Clear @_ so we don't pass anything in by accident...
\r
713 @rev_num = sort revisions @rev_num;
\r
714 print "Sorted rev_nums:\n" . join ("\n", @rev_num) . "\n" if ($options{debug});
\r
717 # Loop through each version label, checking for need to relabel ' ' with '_'.
\r
718 $num_version_labels = $last_vl - $first_vl + 1;
\r
719 print "Version label count is $num_version_labels\n";
\r
720 for( $i = $first_vl; $i <= $last_vl; $i += 1 )
\r
722 # print("$vlog_strings[$i]\n");
\r
723 $label_index = $i - $first_vl;
\r
724 $_=$vlog_strings[$i];
\r
725 print "Starting with string '$_'\n" if ($options{debug});
\r
728 print "Got label '$label'\n" if ($options{debug});
\r
729 split /\s+/, $_[2];
\r
730 $label_revision[$label_index] = $_[2];
\r
731 print "Original label is $label_revision[$label_index]\n" if ($options{debug});
\r
733 # Create RCS revision numbers corresponding to PVCS version numbers by
\r
734 # adding 1 to the revision number (# after last .)
\r
735 $label_revision[ $label_index ] = pvcs_to_rcs_rev_number( $label_revision [ $label_index ] );
\r
736 # replace ' ' with '_', if needed
\r
738 $new_label[$label_index] = $label;
\r
739 $new_label[$label_index] =~ s/ /_/g;
\r
740 $new_label[$label_index] =~ s/\./_/g;
\r
741 $new_label[$label_index] = "\"" . $new_label[$label_index] . "\"";
\r
742 print"Label $new_label[$label_index] is for revision $label_revision[$label_index]\n" if ($options{debug});
\r
747 # See if the RCS archive is up to date with the PVCS archive
\r
750 if ($options{verify} =~ /^locks|exists$/ and -f $rcsarchive)
\r
752 print "Verified existence of $cd/$rcsarchive."
\r
753 . ( ($options{mode} =~ /^convert$/) ? " Skipping." : "" )
\r
754 . "\n" if ($options{verbose});
\r
758 # Create RCS archive and check in all revisions, then label.
\r
759 my $first_time = 1;
\r
760 foreach $revision (@rev_num)
\r
762 # print "get -p$revision $pvcsarchive >$workfile\n";
\r
763 print "get -r$revision $pvcsarchive\n";
\r
764 # $vcs_output = `vcs -u -r$revision $pvcsarchive`;
\r
765 # $get_output = `get -p$revision $pvcsarchive >$workfile`;
\r
766 $get_output = `get -r$revision $pvcsarchive`;
\r
768 # if this is the first time, delete the rcs archive if it exists
\r
769 # need for $options{verify} == none
\r
770 unlink $rcsarchive if ($first_time and $options{verify} =~ /^none$/ and -f $rcsarchive);
\r
772 # Also check here whether this file ought to be "binary"
\r
775 $rcs_command = "$rcs_base_command -i";
\r
776 if ( ( @hits = grep { $workfile =~ /$_/ } keys %bin_ext ) || $options{'force-binary'} )
\r
778 $rcs_command .= " -kb";
\r
779 $workfile =~ /$hits[0]/ if (@hits);
\r
780 print "Binary attribute -kb added ("
\r
781 . (@hits ? "file type is '$bin_ext{$hits[0]}' for extension '$&'" : "forced")
\r
784 $first_time and $ci_command .= " -t-$description";
\r
786 $rcs_command .= " $workfile";
\r
788 # print and execute the rcs archive initialization command
\r
789 print "$rcs_command\n";
\r
790 $wtr = new IO::File "|$rcs_command";
\r
791 $wtr->print ($description);
\r
792 $wtr->print ("\n") unless ($description =~ /\n$/s);
\r
793 $wtr->print (".\n");
\r
796 # $rcs_output = `$rcs_base_command -i -kb $workfile`;
\r
799 # if this isn't the first time, we need to lock the rcs branch
\r
801 # This is a little messy, but it works. Some extra locking is attempted.
\r
802 # (This happens the first time a branch is used, at the least)
\r
805 @branch = split /\./, $rcs_rev_num{$revision};
\r
807 $branch = join ".", @branch;
\r
809 $rcs_output = `$rcs_base_command -l$branch $workfile` if (!$first_time);
\r
811 # If an empty comment is specified, RCS will not check in the file;
\r
812 # check for this case. (but an empty -t- description is fine - go figure!)
\r
813 # Since RCS will pause and ask for a comment if one is not given,
\r
814 # substitute a dummy comment "no comment".
\r
815 $comment{$revision} =~ /^\s*$/ and $comment{$revision} = "no comment\n";
\r
817 $ci_command = $ci_base_command;
\r
818 $ci_command .= " -f -r$rcs_rev_num{$revision} -d$checked_in{$revision}"
\r
819 . " -w$author{$revision}";
\r
821 $ci_command .= " $workfile";
\r
823 # print and execute the ci command
\r
824 print "$ci_command\n";
\r
825 $wtr = new IO::File "|$ci_command";
\r
826 $wtr->print ($comment{$revision});
\r
827 $wtr->print ("\n") unless ($comment{$revision} =~ /\n$/s);
\r
828 $wtr->print (".\n");
\r
830 # $ci_output = `$ci_command`;
\r
831 # $ci_output = `cat $tmpdir/ci.out`;
\r
833 $first_time = 0 if ($first_time);
\r
834 } # foreach revision
\r
836 # Attach version labels
\r
837 for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 )
\r
839 # print "rcs -x,v -n$new_label[$i]:$label_revision[$i] $workfile\n";
\r
840 $rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] $workfile`;
\r
841 print "Version label $new_label[$i] added to revision $label_revision[$i]\n";
\r
845 } # foreach pvcs archive file
\r
847 # We processed a vcs directory, so if there were any files, lock it.
\r
848 # We are guaranteed to have made the attempt at
\r
850 # $skipdirlock gets set if a single file name was passed to this function to enable
\r
851 # a '$0 *' operation...
\r
852 if ( @pvcsarchives && !$skipdirlock)
\r
854 my $fh = new IO::File ">>$donefile_name" or new IO::File ">$donefile_name";
\r
861 error_count 'error', \$errors, "couldn't create lockfile $cd/$donefile_name";
\r
865 $curlevel = $curlevel - 1;
\r
867 chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
\r
868 return ($errors, $warnings);
\r
874 # This function effectively does a cmp between two revision numbers
\r
875 # It is intended to be passed into Perl's sort routine.
\r
877 # the pvcs_out is not implemented well. It should probably be
\r
878 # returnning $b[0] <=> $a[0] rather than $a[0] <=> $b[0]
\r
880 # The @_ argument implementation was going to be used for revision
\r
881 # comparison as an aid to remove the /^\sRev/ in revision comment
\r
882 # error. The effort was fruitless at the time.
\r
885 my @a = split /\./, (defined $a) ? $a : shift;
\r
886 my @b = split /\./, (defined $b) ? $b : shift;
\r
887 my $function = @_ ? shift : 'rcs_in';
\r
890 die "Not enough arguments to revisions : a = ", join (".", @a),
\r
891 "; b = ", join (".", @b), ", stopped"
\r
892 unless (@a and @b);
\r
894 for ($i = 0; $i < scalar( @a ) && $i < scalar( @b ); $i++)
\r
896 $a[$i] == $b[$i] or return ($a[$i] <=> $b[$i]);
\r
899 return 0 if (scalar (@a) == scalar (@b));
\r
901 if ($function eq 'rcs_in')
\r
903 return (($i == @b) || -1);
\r
905 elsif ($function eq 'pvcs_out')
\r
907 return (($i == @a) || -1);
\r
911 die "error - Invalid function type passed to revisions ($function)", ", stopped";
\r
917 sub pvcs_to_rcs_rev_number
\r
919 my($input, $num_fields, @rev_string, $return_rev_num, $i);
\r
923 $num_fields = split /\./;
\r
925 # @rev_string[$num_fields-1] += 1;
\r
927 for( $i = 1; $i < $num_fields; $i += 1 )
\r
932 # RCS does not allow revision zero
\r
933 $rev_string[ $i ] += 1;
\r
938 # Branches must have even references for compatibility
\r
939 # with CVS's magic branch numbers.
\r
940 # (Indexes 2, 4, 6...)
\r
941 $rev_string[ $i ] *= 2;
\r
945 # If this is a branch revision # (PVCS: a.b.c.*) then we want the CVS
\r
946 # revision # instead. It's okay to do this conversion here since we
\r
947 # never commit to branches. We'll only get a PVCS revision # in that
\r
948 # form when looking through the revision labels.
\r
949 if ($input =~ /\*$/)
\r
952 push @rev_string, splice (@rev_string, -1, 1, "0");
\r
955 $return_rev_num = join ".", @rev_string;
\r
956 return $return_rev_num;
\r
968 ### MAIN program: checks to see if there are command line parameters
\r
979 # and read the options
\r
980 die $usage unless GetOptions (\%options, "h|help" => \&exit_help,
\r
981 "recurse!", "mode|m=s", "errorfiles!", "l", "rcs-dirs|rcs-directories|r=s",
\r
982 "pvcs-dirs|pvcs-directories|p=s", "test-binaries|t!",
\r
983 "rcs-extension=s", "verify|v=s", "vcsid|i=s", "verbose!", "debug!",
\r
984 "force-binary!", "cvs-branch-labels!", "warnings|w!");
\r
989 # Special processing for -l !^#%$^@#$%#$
\r
991 # At the moment, -l overrides --recurse, regardless of the order the
\r
992 # options were passed in
\r
994 $options{recurse} = 0 if defined $options{l};
\r
995 delete $options{l};
\r
999 # Make sure we got acceptable values for rcs-dirs and pvcs-dirs
\r
1000 my @hits = grep /^$options{'rcs-dirs'}/i, ("leaf", "flat");
\r
1002 "$0: $options{'rcs-dirs'} invalid argument to --rcs-dirs or ambiguous\n"
\r
1003 . " abbreviation.\n"
\r
1004 . " Must be one of: 'leaf' or 'flat'.\n"
\r
1006 $options{'rcs-dirs'} = $hits[0];
\r
1007 $options{'rcs-dirs-flat'} = ($options{'rcs-dirs'} =~ /flat/);
\r
1008 delete $options{'rcs-dirs'};
\r
1010 @hits = grep /^$options{'pvcs-dirs'}/i, ("leaf", "flat");
\r
1012 "$0: $options{'pvcs-dirs'} invalid argument to --pvcs-dirs or ambiguous\n"
\r
1013 . " abbreviation.\n"
\r
1014 . " Must be one of: 'leaf' or 'flat'.\n"
\r
1016 $options{'pvcs-dirs'} = $hits[0];
\r
1017 $options{'pvcs-dirs-flat'} = ($options{'pvcs-dirs'} =~ /flat/);
\r
1018 delete $options{'pvcs-dirs'};
\r
1021 @hits = grep /^$options{verify}/i, ("none", "locks", "exists", "lockdates", "revs", "full");
\r
1023 "$0: $options{verify} invalid argument to --verify or ambiguous\n"
\r
1024 . " abbreviation.\n"
\r
1025 . " Must be one of: 'none', 'locks', 'exists', 'lockdates', 'revs',\n"
\r
1028 $options{verify} = $hits[0];
\r
1029 $options{verify} =~ /^none|locks|exists$/ or die
\r
1030 "$0: --verify=$options{verify} unimplemented.\n"
\r
1034 @hits = grep /^$options{mode}/i, ("convert", "verify");
\r
1036 "$0: $options{mode} invalid argument to --mode or ambiguous abbreviation.\n"
\r
1037 . " Must be 'convert' or 'verify'.\n"
\r
1039 $options{mode} = $hits[0];
\r
1041 $options{'cvs-branch-labels'} or die
\r
1042 "$0: RCS Branch Labels unimplemented.\n"
\r
1045 # export VCSID into th environment for ourselves and our children
\r
1046 $ENV{VCSID} = $options{vcsid};
\r
1051 # Verify we have all the binary executables we need to run this script
\r
1053 # Allowed this feature to be disabled in case which is missing or we are
\r
1054 # running on a system which does not return error codes properly (e.g. WIN95)
\r
1056 # -- i.e. I don't feel like grepping output yet. --
\r
1058 my @missing_binaries = ();
\r
1059 if ($options{'test-binaries'})
\r
1061 foreach (@bin_dependancies)
\r
1063 if (system "which", $_)
\r
1065 push @missing_binaries, $_;
\r
1069 if (scalar @missing_binaries)
\r
1071 print STDERR "The following executables were not found in your PATH: "
\r
1072 . join ( " ", @missing_binaries )
\r
1074 . "You must correct this before continuing.\n";
\r
1078 delete $options{'test-binaries'};
\r
1083 # set up our base archive manipulation commands
\r
1086 # set up our rcs_command mods
\r
1087 $rcs_base_command = "rcs";
\r
1088 $rcs_base_command .= " -x$options{'rcs-extension'}" if ($options{'rcs-extension'});
\r
1090 # set up our rcs_command mods
\r
1091 $ci_base_command = "ci";
\r
1092 $ci_base_command .= " -x$options{'rcs-extension'}" if ($options{'rcs-extension'});
\r
1097 # So our logs fill in a manner we can monitor with 'tail -f' fairly easily:
\r
1099 STDERR->autoflush (1);
\r
1100 STDOUT->autoflush (1);
\r
1104 # Initialize the globals we use to keep track of recursion
\r
1105 if ($options{recurse})
\r
1107 $maxlevel = 10000; # Arbitrary recursion limit
\r
1113 delete $options{recurse};
\r
1115 # So we can lock the directories behind us
\r
1116 $donefile_name = $options{'rcs-dirs-flat'} ? "" : "RCS/";
\r
1117 $errorfile_name = $donefile_name . "#conv.errors";
\r
1118 $donefile_name .= "#conv.done";
\r
1123 # start the whole thing and drop the return code on exit
\r
1125 push (@ARGV, ".") unless (@ARGV);
\r
1126 while ($_ = shift)
\r
1128 # reset the recursion level (corresponds to directory depth)
\r
1129 # level 0 is the first directory we enter...
\r
1131 my ($e, $w) = execdir($_);
\r
1138 print STDERR "$0: " . ($errors ? "Aborted" : "Done") . ".\n";
\r
1139 print STDERR "$0: ";
\r
1140 print STDERR ($errors ? $errors : "No") . " error" . (($errors != 1) ? "s" : "");
\r
1141 print STDERR ", " . ($warnings ? $warnings : "no") . " warning" . (($warnings != 1) ? "s" : "")
\r
1142 if ($options{warnings});
\r
1143 print STDERR ".\n";
\r
1148 # Woo-hoo! We made it!
\r
projects / FreeBSD / releng / 9.2.git / blob