| blob | ac36ddc0afa5f13d3e3e4482c6ec28589ab5076a |
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.
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 # Binary files which do not have their mode set properly are likely to look
83 # corrupted on initial checkout and use, but using
84 # `cvs admin -kb <workfilename>' to retroactively change the RCS keyword
85 # substitution mode of the file to binary (and refreshing the files in any
86 # local workspaces they are checked out in: `rm <workfilename>; update'
87 # should do the trick) should end any problems with the original import.
88 # If anyone has checked in changes since the import, those revisions may
89 # be corrupted in the imported archive and therefore those changes (commits
90 # of corrupted data) may need to be backed out.
91 # * This script writes lockfiles in the RCS/ directories. It will also not
92 # convert an archive if it finds the RCS Archive existant in the RCS/
93 # directory. This enables the conversion to quickly pick up where it left
94 # off after errors or interrupts occur. If you interrupt the script make
95 # sure you delete the last RCS Archive File which was being written.
96 # If you recieve the "Invalid revision number" error, then the RCS archive
97 # file for that particular PVCS file will not have been created yet.
98 # * This script will not create lockfiles when processing single
99 # filenames passed into the script, for hopefully obvious reasons.
100 # (lockfiles lock directories - DRP)
101 # * Log the output to a file. That makes it real easy to grep for errors
102 # later. (grep for "^[ \t]*(rcs|ci):" and be aware I might have missed
103 # a few cases (get? vcs?) !!!) *** Also note that this script will
104 # exibit some harmless RCS errors. Namely, it will attempt to lock
105 # branches which haven't been created yet. ***
106 # * I tried to keep the error and warning info up to date, but it seems
107 # to mean very little. This script almost always exits with a warning
108 # or an error that didn't seem to cause any harm. I didn't trace it
109 # and our imported source checks out and builds...
110 # It is probably happening when trying to convert empty directories
111 # or read files (possibly checked out workfiles ) which are not
112 # pvcs_archives.
113 # * You must use the -pflat option when processing single filenames
114 # passed as arguments to the script. This is probably a bug.
115 # * questions, comments, additions can be sent to info-cvs@nongnu.org
116 #########################################################################
120 #
121 # USER Configurables
122 #
124 # %bin_ext should be editable from the command line.
125 #
126 # NOTE: Each possible binary extension is listed as a Perl regexp
127 #
128 # The value associated with each regexp key is used to print a log
129 # message when a binary file is found.
130 my %bin_ext =
131 (
132 '\.(?i)abs$' => "Absolute File",
133 '\.(?i)bin$' => "Binary",
134 '\.(?i)bit$' => "Bit File",
135 '\.(?i)ol$' => "Compiler Output",
136 '\.(?i)out$' => "Default Compiler Output",
137 '\.(?i)ln$' => "Linker Output",
138 '\.(?i)lob$' => "Lint Output",
139 '\.(?i)zob$' => "DBCO Object",
140 '\.(?i)mim$' => "MIME File",
141 '\.(?i)dwi$' => "DWI File",
142 '\.(?i)iop$' => "IOP File",
143 '\.(?i)btl$' => "",
144 '\.(?i)rom$' => "ROM File",
145 '\.(?i)a07$' => "",
146 '\.(?i)lib$' => "DOS/Wintel/Netware Compiler Library",
147 '\.(?i)lif$' => "Netware Binary File",
148 '\.(?i)(com|exe)$' => "DOS/Wintel Executable",
149 '\.(?i)tco$' => "",
150 '\.(?i)obj$' => "DOS/Wintel Compiler Object",
151 '\.(?i)res$' => "DOS/Wintel Resource File",
152 '\.(?i)ico$' => "DOS/Wintel Icon File",
153 '\.(?i)nlm$' => "Netware Loadable Module",
154 '\.(?i)t8u$' => "",
155 '\.(?i)c8u$' => "",
156 '\.(?i)lku$' => "",
157 '\.(?i)pdf$' => "Adobe Acrobat Portable Document Format",
158 '\.(?i)doc$' => "MS Word Document",
159 '\.(?i)dot$' => "MS Word Document Template",
160 '\.(?i)pps$' => "MS PowerPoint Presentation",
161 '\.(?i)xls$' => "MS Excel Spreadsheet",
162 '\.(?i)(bmp|gif|jfif|jpeg|jpg|png|tif|tiff|xbm)$' => "Image",
163 '\.(?i)(bz2|gz|tgz|zip)$' => "Compressed File",
164 '\.(?i)dll$' => "DOS/Wintel Dynamically Linked Library",
165 '\.(?i)class$' => "Compliled Java Class File",
166 '\.(?i)jar$' => "Java Archive File",
167 '\.(?i)war$' => "Java Web Archive File",
168 '\.o$' => "UNIX Compiler Object",
169 '\.a$' => "UNIX Compiler Library",
170 '\.so(\.\d+\.\d+)?$' => "UNIX Shared Library"
171 );
173 # The binaries this script is dependant on:
174 my @bin_dependancies = ("vcs", "vlog", "rcs", "ci");
176 # Where we should put temporary files
177 my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/var/tmp";
179 # We use these...
180 use strict;
182 use Cwd;
183 use File::Basename; # For the usage message.
184 use File::Copy;
185 use File::Path;
186 use IO::File;
187 use Getopt::Long;
188 $Getopt::Long::bundling = 1;
190 my $program = basename $0;
191 my $usage = "\
192 usage: $program -h
193 $program [-lt] [-i vcsid] [-r flat|leaf] [-p flat|leaf]
194 [-x rcs_extension] [-v none|locks|exists] [options] [path...]
195 ";
197 my $help = "\
198 $usage
199 ---------------------------- -----------------------------------
200 -h | --Help Print this text
202 General Settings
203 ---------------------------- -----------------------------------
204 --Recurse Recurse through directories
205 (default)
206 -l | --NORecurse Process only .
207 --Errorfiles Save a count of conversion errors
208 in the RCS archive directory
209 (default) (unimplemented)
210 --NOErrorfiles Don't save a count of conversion
211 errors (unimplemented)
212 ( -m | --Mode ) Convert Convert PVCS files to RCS files
213 (default)
214 ( -m | --Mode ) Verify Perform verification ONLY
215 (unimplemented)
216 ( -v | --VERIfy ) None Always replace existing RCS files
217 ( -v | --VERIfy ) LOCKS Same as exists unless a #conv.done
218 file exists in the RCS directory.
219 In that case, only the #conv.done
220 file's existance is verified for
221 that directory. (default)
222 ( -v | --VERIfy ) Exists Don't replace existing RCS files
223 ( -v | --VERIfy ) LOCKDates Verify that an existing RCS file's
224 last modification date is older
225 than that of the lockfile
226 (unimplemented)
227 ( -v | --VERIfy ) Revs Verify that the PVCS archive files
228 and RCS archive file contain the
229 same number of corresponding
230 revisions. Add only new revisions
231 to the RCS file. (unimplemented)
232 ( -v | --VERIfy ) Full Perform --verify=Revs and confirm
233 that the text of the revisions is
234 identical. Add only new revisions
235 unless an error is found. Then
236 erase the RCS archive and recreate
237 it. (unimplemented)
238 -t | --Test-binaries Use 'which' to check \$PATH for
239 the binaries required by this
240 script (default)
241 --NOTest-binaries Don't check for binaries
242 --VERBose Enable verbose output
243 --NOVerbose Disable verbose output (default)
244 -w | --Warnings Print warning messages (default)
245 --NOWarnings Don't print warning messages
247 RCS Settings
248 ---------------------------- -----------------------------------
249 ( -r | --RCS-Dirs ) leaf RCS files stored in ./RCS (default)
250 ( -r | --RCS-Dirs ) flat RCS files stored in .
251 (unimplemented)
252 ( -x | --RCS-Extension ) Set RCS file extension
253 (default = ',v')
254 --Force-binary Pass '-kb' to 'rcs -i' regardless
255 of the file extension
256 --NOForce-binary Only use '-kb' when the file has
257 a binary extension (default)
258 --CVS-Branch-labels Use CVS magic branch revision
259 numbers when attaching branch
260 labels (default)
261 --NOCvs-branch-labels Attach branch labels to RCS branch
262 revision numbers (unimplemented)
264 CVS Settings
265 ---------------------------- -----------------------------------
266 ( -d | --CVS-Module-path) Import RCS files directly into this
267 destination directory rather than
268 converting in place
270 PVCS Settings
271 ---------------------------- -----------------------------------
272 ( -p | --Pvcs-dirs ) leaf PVCS files expected in ./VCS
273 (default)
274 ( -p | --Pvcs-dirs ) flat PVCS files expected in .
275 ( -i | --VCsid ) vcsid Use vcsid instead of \$VCSID
277 --------------------------------------------------------------------------
278 The optional path argument should contain the name of a file or directory
279 to convert. If not given, it will default to '.'.
280 --------------------------------------------------------------------------
281 ";
285 #
286 # Initialize globals
287 #
289 my ($errors, $warnings) = (0, 0);
290 my ($curlevel, $maxlevel);
291 my ($rcs_base_command, $ci_base_command);
292 my ($donefile_name, $errorfile_name);
293 my @rel_dirs = (); # list of relative directory names up to current dir
296 # set up the default options
297 my %options = (
298 'recurse' => 1,
299 'mode' => "convert",
300 'errorfiles' => 1,
301 'rcs-dirs' => "leaf",
302 'rcs-extension' => ",v",
303 'force-binary' => 0,
304 'cvs-branch-labels' => 1,
305 'cvs-module-path' => undef,
306 'pvcs-dirs' => "leaf",
307 'verify' => "locks",
308 'test-binaries' => 1,
309 'vcsid' => $ENV{VCSID} || "",
310 'verbose' => 0,
311 'debug' => 0,
312 'warnings' => 1
313 );
317 # This is untested except under Solaris 2.4 or 2.6 and
318 # may not be portable
319 #
320 # I think the readline lib or some such has an interface
321 # which may enable this now. The perl installer sure looks
322 # like it's testing this kind of thing, anyhow.
323 sub hit_any_key
324 {
325 STDOUT->autoflush;
326 system "stty", "-icanon", "min", "1";
328 print "Hit any key to continue...";
329 getc;
331 system "stty", "icanon", "min", "0";
332 STDOUT->autoflush (0);
334 print "\nI always wondered where that key was...\n";
335 }
339 # print the usage
340 sub print_usage
341 {
342 my $fh = shift;
343 unless (ref $fh)
344 {
345 my $fdn = $fh ? $fh : "STDERR";
346 $fh = new IO::File;
347 $fh->fdopen ($fdn, "w");
348 }
350 $fh->print ($usage);
351 }
353 # print the help
354 sub print_help
355 {
356 my $fh = shift;
357 unless (ref $fh)
358 {
359 my $fdn = $fh ? $fh : "STDOUT";
360 $fh = new IO::File;
361 $fh->fdopen ($fdn, "w");
362 }
364 $fh->print ($help);
365 }
367 # print the help and exit $_[0] || 0
368 sub exit_help
369 {
370 print_help;
371 exit shift || 0;
372 }
374 sub error_count
375 {
376 my $type = shift
377 or die "$0: error - error_count usage: error_count type [, ref] [, LIST]\n";
378 my $error_count_ref;
379 my $outstring;
381 if (ref ($_[0]) && ref ($_[0]) == "SCALAR")
382 {
383 $error_count_ref = shift;
384 }
385 else
386 {
387 $error_count_ref = \$errors;
388 }
389 $$error_count_ref++;
391 push @_, "something wrong.\n" unless ( @_ > 0 );
393 $outstring = sprintf "$0: $type - " . join ("", @_);
394 $outstring .= sprintf " - $!\n" unless ($outstring =~ /\n$/);
396 print STDERR $outstring;
398 if ($options{errorfiles})
399 {
400 my $fh = new IO::File ">>$errorfile_name" or new IO::File ">$errorfile_name";
401 if ($fh)
402 {
403 $fh->print ($$error_count_ref . "\n");
404 $fh->print ($outstring);
405 $fh->close;
406 }
407 else
408 {
409 my $cd = cwd;
410 print STDERR "$0: error - failed to open errorfile $cd/$errorfile_name - $!\n"
411 if ($options{debug});
412 }
413 }
415 return $$error_count_ref;
416 }
420 # the main procedure that is run once in each directory
421 sub execdir
422 {
423 my $dir = shift;
424 my ($errors, $warnings) = (0, 0); # We return these error counters
425 my $old_dir = cwd;
427 local ($_, @_);
429 my $i; # Generic counter
430 my ($pvcsarchive, $workfile, $rcsarchive); # .??v, checked out file, and ,v files,
431 # respectively
432 my ($rev_count, $first_vl, $last_vl, $description,
433 $rev_index, @rev_num, %checked_in, %author,
434 $relative_comment_index, @comment_string,
435 %comment);
436 my ($num_version_labels, $label_index, @label_revision, $label,
437 @new_label, $rcs_rev);
438 my ($revision, %rcs_rev_num);
439 my @remainder;
440 my ($get_output, $rcs_output, $ci_output, $mv_output);
441 my ($ci_command, $rcs_command, $wtr);
442 my @hits;
443 my ($num_fields);
444 my $skipdirlock; # if true, don't write conv.out
445 # used only for single file operations
446 # at the moment
447 my $cd;
448 my $cvs_dir;
450 my @filenames;
451 # We may have recieved a single file name to process...
452 if ( -d $dir )
453 {
454 # change into the directory to be processed
455 # open the current directory for listing
456 # initialize the list of filenames
457 # and set filenames equal to directory listing
458 unless ( ( chdir $dir ) and ( opendir CURDIR, "." ) and ( @filenames = readdir CURDIR ) )
459 {
460 $cd = cwd;
461 error_count 'error', \$errors, "skipping directory $dir from $cd";
462 chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
463 return ($errors, $warnings);
464 }
466 # clean up by closing the directory
467 closedir(CURDIR);
469 if ($options{'rcs-dirs-flat'} && $options{'cvs-module-path'})
470 {
471 my @cur_dir_names = split qr{[/\\]}, cwd;
472 my $rel_cd = $cur_dir_names[-1];
473 push @rel_dirs, $rel_cd;
474 $cvs_dir = "$options{'cvs-module-path'}/"
475 . join "/", @rel_dirs;
476 if (!-d $cvs_dir)
477 {
478 print "Creating directory \`$cvs_dir'\n";
479 if (!mkpath ($cvs_dir))
480 {
481 pop @rel_dirs;
482 error_count 'error', \$errors,
483 "failed to make directory \`$cvs_dir' - skipping directory \`$cd'";
484 chdir $old_dir or die
485 "Failed to restore original directory (\`$old_dir'): ", $!, ", stopped";
486 return ($errors, $warnings);
487 # after all, we have nowhere to put
488 # them...
489 }
490 }
491 }
493 }
494 elsif ( -f $dir ) # we recieved a single file
495 {
496 push @filenames, $dir;
497 $skipdirlock = 1;
498 }
499 else
500 {
501 $cd = cwd;
502 error_count 'error', \$errors, "no such directory/file $dir from $cd\n";
503 chdir $old_dir or die
504 "Failed to restore original directory ($old_dir): ", $!, ", stopped";
505 return ($errors, $warnings);
506 }
508 # save the current directory
509 $cd = cwd;
511 # increment the global $curlevel variable
512 $curlevel = $curlevel +1;
514 # initialize a list for any subdirectories and any files
515 # we need to process
516 my $vcsdir = "";
517 my (@subdirs, $fn, $file, @files, @pvcsarchives);
519 # print "$cd: " . join (", ", @filenames) . "\n";
520 # hit_any_key;
522 (@files, @pvcsarchives) = ( (), () );
523 # begin a for loop to execute on each filename in the list @filename
524 foreach $fn (@filenames)
525 {
526 # if the file is a directory...
527 if (-d $fn)
528 {
529 # then if we are not expecting a flat arrangement of pvcs files
530 # and we found a vcs directory add its files to @pvcsarchives
531 if (!$options{'pvcs-dirs-flat'} and $fn =~ /^vcs$/i)
532 {
533 if ($options{verify} =~ /^locks$/ ) {
534 if ( -f $donefile_name ) {
535 print "Verified existence of lockfile $cd/$donefile_name."
536 . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" )
537 . "\n" if ($options{verbose});
538 next;
539 } elsif ( $options{mode} =~ /^verify$/ ) {
540 print "No lockfile found for $cd .\n";
541 next;
542 }
543 }
545 # else add the files in the vcs dir to our list of files to process
546 error_count 'warning', \$warnings, "Found two vcs dirs in directory $cd.\n"
547 if ($vcsdir and $options{warnings});
549 $vcsdir = $fn;
551 unless ( ( opendir VCSDIR, $vcsdir ) and ( @files = readdir VCSDIR ) )
552 {
553 error_count 'error', \$errors, "skipping directory &cd/$fn";
554 next;
555 }
556 closedir VCSDIR;
558 # and so we don't need to worry about where these
559 # files came from later...
560 foreach $file (@files)
561 {
562 push @pvcsarchives, "$vcsdir/$file" if (-f "$vcsdir/$file");
563 }
565 # don't want recursion here...
566 @pvcsarchives = grep !/^\.\.?$/, @pvcsarchives;
567 }
568 elsif ($fn !~ /^\.\.?$/)
569 {
570 next if (!$options{'rcs-dirs-flat'} and $fn =~ /^rcs$/i);
571 # include it in @subdir if it's not a parent directory
572 push(@subdirs,$fn);
573 }
574 }
575 # else if we are processing a flat arrangement of pvcs files...
576 elsif ($options{'pvcs-dirs-flat'} and -f $fn)
577 {
578 if ($options{verify} =~ /^locks$/) {
579 if ( -f $donefile_name) {
580 print "Found lockfile $cd/$donefile_name."
581 . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" )
582 . "\n" if ($options{verbose});
583 last;
584 } elsif ($options{mode} =~ /^verify$/) {
585 print "No lockfile found for $cd .\n";
586 last;
587 }
588 }
589 # else add this to the list of files to process
590 push (@pvcsarchives, $fn);
591 }
592 }
594 # print "pvcsarchives: " . join (", ", @pvcsarchives) . "\n";
595 # print "subdirs: " . join (", ", @subdirs) . "\n";
596 # hit_any_key;
598 # for loop of subdirs
599 foreach (@subdirs)
600 {
601 # run execdir on each sub dir
602 if ($maxlevel >= $curlevel)
603 {
604 my ($e, $w) = execdir ($_);
605 $errors += $e;
606 $warnings += $w;
607 }
608 }
610 # Print output header for each directory
611 print("Directory: $cd\n");
613 # the @files variable should already contain the list of files
614 # we should attempt to process
615 if ( @pvcsarchives && ( $options{mode} =~ /^convert$/ ) )
616 {
617 # create an RCS directory in parent to store RCS files in
618 if ( !( $options{'rcs-dirs-flat'} or (-d "RCS") or mkpath ( "RCS" ) ) )
619 {
620 error_count 'error', \$errors, "failed to make directory $cd/RCS - skipping directory $cd";
621 @pvcsarchives = ();
622 # after all, we have nowhere to put them...
623 }
624 }
626 # begin a for loop to execute on each filename in the list @files
627 foreach $pvcsarchive (@pvcsarchives)
628 {
629 my $got_workfile = 0;
630 my $got_version_labels = 0;
631 my $got_description = 0;
632 my $got_rev_count = 0;
634 my $abs_file = $cd . "/" . $pvcsarchive;
636 print("Verifying $abs_file...\n") if ($options{verbose});
638 print "vlog $pvcsarchive\n";
639 # FIXME: Quoting this is better than no quotes, but quotes in
640 # filenames remain unquoted.
641 my $vlog_output = `vlog \"$pvcsarchive\"`;
643 # Split the vcs status output into individual lines
644 my @vlog_strings = split /\n/, $vlog_output;
645 my $num_vlog_strings = @vlog_strings;
646 $_ = $vlog_strings[0];
647 if ( /^\s*$/ || /^vlog: warning/ )
648 {
649 error_count 'warning', \$warnings, "$abs_file is NOT a valid PVCS archive!!!\n";
650 next;
651 }
653 my $num;
654 # Collect all vlog output into appropriate variables
655 #
656 # This will ignore at the very least the /^\s*Archive:\s*/ field
657 # and maybe more. This should not be a problem.
658 for ( $num = 0; $num < $num_vlog_strings; $num++ )
659 {
660 # print("$vlog_strings[$num]\n");
661 $_ = $vlog_strings[$num];
663 if( ( /^Workfile:\s*/ ) && (!$got_workfile ) )
664 {
665 my $num_fields;
667 $got_workfile = 1;
668 # get the string to the right of the above search (with any path stripped)
669 $workfile = $';
670 $num_fields = split /[\/\\]/, $workfile;
671 if ( $num_fields > 1 )
672 {
673 $workfile = $_[$num_fields - 1 ];
674 }
676 $rcsarchive = $options{'rcs-dirs-flat'} ? "" : "RCS/";
677 $rcsarchive .= $workfile;
678 $rcsarchive .= $options{'rcs-extension'} if ($options{'rcs-extension'});
679 print "Workfile is $workfile\n" if ($options{debug});
680 }
682 elsif ( ( /^Rev count:\s*/ ) && (!$got_rev_count ) )
683 {
684 $got_rev_count = 1;
685 # get the string to the right of the above search
686 $rev_count = $';
687 print "Revision count is $rev_count\n";
688 }
690 elsif ( ( /^Version labels:\s*/ ) && (!$got_version_labels ) )
691 {
692 $got_version_labels = 1;
693 $first_vl = $num+1;
694 print "Version labels start at $first_vl\n" if ($options{debug});
695 }
697 elsif ( ( /^Description:\s*/ ) && (!$got_description ) )
698 {
699 $got_description = 1;
700 $description = $vlog_strings[$num+1];
701 print "Description is `$description'\n" if ($options{debug});
702 $last_vl = $num++ - 1;
703 }
705 elsif ( /^Rev\s+/ ) # get all the revision information at once
706 {
707 $rev_index = 0;
708 @rev_num = ();
709 while ( $rev_index < $rev_count )
710 {
711 $_ = $vlog_strings[$num];
712 /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/;
713 $rev_num[$rev_index] = $1;
714 print "Found revision: $rev_num[$rev_index]\n" if ($options{debug});
715 die "Not a valid revision ($rev_num[$rev_index]).\n"
716 if ($rev_num[$rev_index] !~ /^(\d+\.)(\d+\.\d+\.)*\d+$/);
718 $_ = $vlog_strings[$num+1];
719 /^\s*Locked\s*/ and $num++;
721 $_ = $vlog_strings[$num+1];
722 /^\s*Checked in:\s*/;
723 $checked_in{$rev_num[$rev_index]} = "\"" . $' . "\"";
724 print "Checked in: $checked_in{$rev_num[$rev_index]}\n" if ($options{debug});
726 $_ = $vlog_strings[$num+3];
727 /^\s*Author id:\s*/;
728 my @fields = split;
729 $author{$rev_num[$rev_index]} = "\"" . $fields[2] . "\"";
730 print "Author: $author{$rev_num[$rev_index]}\n" if ($options{debug});
732 my @branches = ();
733 $_ = $vlog_strings[$num+1];
734 if (/^\s*Branches:\s*/)
735 {
736 $num++;
737 @branches = split /\s+/, $';
738 }
740 $relative_comment_index = 0;
741 @comment_string = ();
742 while (($num + 4 + $relative_comment_index) < @vlog_strings)
743 {
744 last if $vlog_strings[$num+4+$relative_comment_index]
745 =~ /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/
746 && $vlog_strings[$num+3+$relative_comment_index]
747 =~ /^-{35}$/;
749 # We need the \n added for multi-line comments. There is no effect for
750 # single-line comments since RCS inserts the \n if it doesn't exist already
751 # print "Found commment line: $vlog_strings[$num+4+$relative_comment_index]\n"
752 # if ($options{debug});
753 push @comment_string, $vlog_strings[$num+4+$relative_comment_index], "\n";
754 $relative_comment_index += 1;
755 }
756 # print "Popped from comment: " . join ("", splice (@comment_string, -2))
757 # . "\n"
758 # if ($options{debug});
759 # Pop the "-+" or "=+" line from the comment
760 while ( (pop @comment_string) !~ /^-{35}|={35}$/ )
761 {}
762 $comment{$rev_num[$rev_index]} = join "", @comment_string;
764 $num += ( 4 + $relative_comment_index );
765 print "Got comment for $rev_num[$rev_index]\n" if ($options{debug});
766 print "comment string: $comment{$rev_num[$rev_index]}\n" if ($options{debug});
767 $rev_index += 1;
768 } # while ( $rev_index < $rev_count )
769 $num -= 1; #although there should be nothing left for this to matter
770 } # Get Rev information
771 } # for ($num = 0; $num < $num_vlog_strings; $num++)
772 # hit_any_key if ($options{debug});
773 # Create RCS revision numbers corresponding to PVCS version numbers
774 my @rcs_rev_nums;
775 foreach $revision (@rev_num)
776 {
777 $rcs_rev_num{ $revision } = &pvcs_to_rcs_rev_number( $revision );
778 push @rcs_rev_nums, $rcs_rev_num{$revision};
779 print"PVCS revision is $revision; RCS revision is $rcs_rev_num{ $revision }\n"
780 if ($options{debug});
781 }
783 # Sort the revision numbers - PVCS and RCS store them in different orders
784 # Clear @_ so we don't pass anything in by accident...
785 @_ = ();
786 @rev_num = sort revisions @rev_num;
787 print "Sorted rev_nums:\n" . join ("\n", @rev_num) . "\n" if ($options{debug});
788 # hit_any_key;
790 # Loop through each version label, checking for need to relabel ' ' with '_'.
791 $num_version_labels = $last_vl - $first_vl + 1;
792 print "Version label count is $num_version_labels\n";
793 for( $i = $first_vl; $i <= $last_vl; $i += 1 )
794 {
795 # print("$vlog_strings[$i]\n");
796 $label_index = $i - $first_vl;
797 $_=$vlog_strings[$i];
798 print "Starting with string '$_'\n" if ($options{debug});
799 my @fields = split /\"/;
800 $label = $fields[1];
801 print "Got label '$label'\n" if ($options{debug});
802 @fields = split /\s+/, $fields[2];
803 $label_revision[$label_index] = $fields[2];
804 print "Original label is $label_revision[$label_index]\n" if ($options{debug});
806 # Create RCS revision numbers corresponding to PVCS version numbers by
807 # adding 1 to the revision number (# after last .)
808 $label_revision[ $label_index ] = pvcs_to_rcs_rev_number( $label_revision [ $label_index ] );
809 # replace ' ' with '_', if needed
810 $_=$label;
811 $new_label[$label_index] = $label;
812 $new_label[$label_index] =~ s/ /_/g;
813 $new_label[$label_index] =~ s/\./_/g;
814 $new_label[$label_index] = "\"" . $new_label[$label_index] . "\"";
815 print"Label $new_label[$label_index] is for revision $label_revision[$label_index]\n" if ($options{debug});
816 }
818 ##########
819 #
820 # See if the RCS archive is up to date with the PVCS archive
821 #
822 ##########
823 my $cvsarchive;
824 $cvsarchive = "$cvs_dir/$rcsarchive" if $options{'cvs-module-path'};
825 $cvsarchive .= $rcsarchive;
826 if ($options{verify} =~ /^locks|exists$/ and -f $cvsarchive)
827 {
828 print "Verified existence of "
829 . ($options{'cvs-module-path'} ? $cvsarchive : "$cd/$rcsarchive")
830 . "."
831 . ( ($options{mode} =~ /^convert$/) ? " Skipping." : "" )
832 . "\n" if ($options{verbose});
833 next;
834 }
836 # Create RCS archive and check in all revisions, then label.
837 my $first_time = 1;
838 foreach $revision (@rev_num)
839 {
840 # print "get -p$revision $pvcsarchive >$workfile\n";
841 print "get -r$revision $pvcsarchive\n";
842 # $vcs_output = `vcs -u -r$revision $pvcsarchive`;
843 # $get_output = `get -p$revision $pvcsarchive >$workfile`;
844 # FIXME: Doesn't handle quotes in filenames as FIXME above.
845 $get_output = `get -r$revision \"$pvcsarchive\"`;
847 # if this is the first time, delete the rcs archive if it exists
848 # need for $options{verify} == none
849 unlink $rcsarchive if ($first_time and $options{verify} =~ /^none$/ and -f $rcsarchive);
851 # Also check here whether this file ought to be "binary"
852 if ( $first_time )
853 {
854 $rcs_command = "$rcs_base_command -i";
855 if ( ( @hits = grep { $workfile =~ /$_/ } keys %bin_ext ) || $options{'force-binary'} )
856 {
857 $rcs_command .= " -kb";
858 $workfile =~ /$hits[0]/ if (@hits);
859 print "Binary attribute -kb added ("
860 . (@hits ? "file type is '$bin_ext{$hits[0]}' for extension '$&'" : "forced")
861 . ")\n";
862 }
864 # FIXME: Doesn't handle quotes and other special characters in
865 # filenames as two FIXMEs above.
866 $rcs_command .= " \"$workfile\"";
868 # print and execute the rcs archive initialization command
869 print "$rcs_command\n";
870 $wtr = new IO::File "|$rcs_command";
871 $wtr->print ($description);
872 $wtr->print ("\n") unless ($description =~ /\n$/s);
873 $wtr->print (".\n");
874 $wtr->close;
876 # $rcs_output = `$rcs_base_command -i -kb $workfile`;
877 }
879 # if this isn't the first time, we need to lock the rcs branch
880 #
881 # This is a little messy, but it works. Some extra locking is attempted.
882 # (This happens the first time a branch is used, at the least)
883 my $branch = "";
884 my @branch;
885 @branch = split /\./, $rcs_rev_num{$revision};
886 pop @branch;
887 $branch = join ".", @branch if @branch != 1;
889 # FIXME: Quotes around file names handles spaces but not shell
890 # metacharacters in file names.
891 unless ($first_time)
892 {
893 print "$rcs_base_command -l$branch \"$workfile\"\n"
894 if $options{'debug'};
895 $rcs_output = `$rcs_base_command -l$branch \"$workfile\"`;
896 }
898 # If an empty comment is specified, RCS will not check in the file;
899 # check for this case. (but an empty -t- description is fine - go figure!)
900 # Since RCS will pause and ask for a comment if one is not given,
901 # substitute a dummy comment "no comment".
902 $comment{$revision} =~ /^\s*$/ and $comment{$revision} = "no comment\n";
904 $ci_command = $ci_base_command;
905 $ci_command .= " -f -r$rcs_rev_num{$revision} -d$checked_in{$revision}"
906 . " -w$author{$revision}";
908 $ci_command .= " \"$workfile\"";
910 # print and execute the ci command
911 print "$ci_command\n";
912 $wtr = new IO::File "|$ci_command";
913 $wtr->print ($comment{$revision});
914 $wtr->print ("\n") unless ($comment{$revision} =~ /\n$/s);
915 $wtr->print (".\n");
916 $wtr->close;
917 # $ci_output = `$ci_command`;
918 # $ci_output = `cat $tmpdir/ci.out`;
920 $first_time = 0 if ($first_time);
921 } # foreach revision
923 # Keep track of 1.*, 2.*, etc. branches as they are created.
924 my %trunk_branches;
926 # Attach version labels
927 for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 )
928 {
929 print "$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"\n"
930 if $options{'debug'};
931 $rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`;
932 print "Version label $new_label[$i] added to revision $label_revision[$i]\n";
934 # If the label revision is attached to a 1.* revision on the trunk
935 # when a 2.* revision exists, then 1.MAX needs to be branched to
936 # allow commits to this label. This applies to 2.* when 3.*
937 # exists, as well.
938 if ($label_revision[$i] !~ /\./)
939 {
940 # This revision is attached to the trunk.
941 # $rcs_rev_nums[0] will always be the max revision.
942 print "Label `$new_label[$i]' moved from $label_revision[$i] to ";
943 if (exists $trunk_branches{$label_revision[$i]})
944 {
945 $label_revision[$i] = $trunk_branches{$label_revision[$i]};
946 }
947 else
948 {
949 # Attached to X.* with X < M
950 my @X_revs = grep /^$label_revision[$i]\./, @rcs_rev_nums;
951 # Need a _NEW_ branch from $X_revs[0] to attach
952 # to. CVS could do this easily, but our archive
953 # isn't in a CVS repository yet.
954 my @tmp_lbl = @label_revision;
955 my @branch_nums = grep s/^\Q$X_revs[0]\E\.0\.(\d+)$/$1/, @tmp_lbl;
956 @tmp_lbl = @rcs_rev_nums;
957 push @branch_nums,
958 grep (s/^\Q$X_revs[0]\E\.(\d+)\.\d+$/$1/, @tmp_lbl);
959 my $max = 0;
960 foreach my $num (@branch_nums)
961 {
962 $max = $num if $num > $max;
963 }
964 $max += 2;
965 $trunk_branches{$label_revision[$i]} = "$X_revs[0].0.$max";
966 $label_revision[$i] = "$X_revs[0].0.$max";
967 }
968 print "$label_revision[$i].\n";
969 }
971 $rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`;
972 print "Version label $new_label[$i] added to revision $label_revision[$i]\n";
974 if ($label_revision[$i] =~ /^(.*)\.0\./)
975 {
976 my $base = $1;
977 my $rootlbl = $new_label[$i];
978 $rootlbl =~ s/.$/_broot$&/;
979 $rcs_output = `$rcs_base_command -n$rootlbl:$base \"$workfile\"`;
980 print "Version label $rootlbl added to revision $base\n";
981 }
983 } # foreach label
985 if ($options{'cvs-module-path'})
986 {
987 print "Moving $rcsarchive to $cvsarchive\n";
988 move $rcsarchive, $cvsarchive or warn "Move failed: $!";
989 }
991 # hit_any_key;
992 } # foreach pvcs archive file
994 # We processed a vcs directory, so if there were any files, lock it.
995 # We are guaranteed to have made the attempt at
996 #
997 # $skipdirlock gets set if a single file name was passed to this function to enable
998 # a '$0 *' operation...
999 if ( @pvcsarchives && !$skipdirlock)
1000 {
1001 my $fh = new IO::File ">>$donefile_name" or new IO::File ">$donefile_name";
1002 if ($fh)
1003 {
1004 $fh->close;
1005 }
1006 else
1007 {
1008 error_count 'error', \$errors, "couldn't create lockfile $cd/$donefile_name";
1009 }
1010 }
1012 $curlevel = $curlevel - 1;
1014 chdir $old_dir
1015 or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
1017 # Update the relative directory path.
1018 pop @rel_dirs if -d $dir;
1020 return ($errors, $warnings);
1021 }
1025 #
1026 # This function effectively does a cmp between two revision numbers
1027 # It is intended to be passed into Perl's sort routine.
1028 #
1029 # the pvcs_out is not implemented well. It should probably be
1030 # returnning $b[0] <=> $a[0] rather than $a[0] <=> $b[0]
1031 #
1032 # The @_ argument implementation was going to be used for revision
1033 # comparison as an aid to remove the /^\sRev/ in revision comment
1034 # error. The effort was fruitless at the time.
1035 sub revisions
1036 {
1037 my @a = split /\./, (defined $a) ? $a : shift;
1038 my @b = split /\./, (defined $b) ? $b : shift;
1039 my $function = @_ ? shift : 'rcs_in';
1040 my ($i, $ret_val);
1042 die "Not enough arguments to revisions : a = ", join (".", @a),
1043 "; b = ", join (".", @b), ", stopped"
1044 unless (@a and @b);
1046 for ($i = 0; $i < scalar( @a ) && $i < scalar( @b ); $i++)
1047 {
1048 $a[$i] == $b[$i] or return ($a[$i] <=> $b[$i]);
1049 }
1051 return 0 if (scalar (@a) == scalar (@b));
1053 if ($function eq 'rcs_in')
1054 {
1055 return (($i == @b) || -1);
1056 }
1057 elsif ($function eq 'pvcs_out')
1058 {
1059 return (($i == @a) || -1);
1060 }
1061 else
1062 {
1063 die "error - Invalid function type passed to revisions ($function)", ", stopped";
1064 }
1065 }
1069 sub pvcs_to_rcs_rev_number
1070 {
1071 my($input, $num_fields, @rev_string, $return_rev_num, $i);
1073 $input = $_[0];
1074 $num_fields = split /\./, $input;
1075 @rev_string = @_;
1076 # @rev_string[$num_fields-1] += 1;
1078 for( $i = 1; $i < $num_fields; $i += 1 )
1079 {
1080 if ( $i % 2 )
1081 {
1082 # DRP: 10/1
1083 # RCS does not allow revision zero
1084 $rev_string[ $i ] += 1;
1085 }
1086 elsif ( $i )
1087 {
1088 # DRP: 10/1
1089 # Branches must have even references for compatibility
1090 # with CVS's magic branch numbers.
1091 # (Indexes 2, 4, 6...)
1092 $rev_string[ $i ] *= 2;
1093 }
1094 }
1096 # If this is a branch revision # (PVCS: a.b.c.*) then we want the CVS
1097 # revision # instead. It's okay to do this conversion here since we
1098 # never commit to branches. We'll only get a PVCS revision # in that
1099 # form when looking through the revision labels.
1100 if ($input =~ /\*$/)
1101 {
1102 pop @rev_string;
1103 # If there is only one entry in @rev_string, this is a
1104 # revision that needs to be attached to the trunk. Let it be
1105 # for now. It might require a new branch, but we can't decide
1106 # which branches are valid to create before we know what
1107 # branches already exist.
1108 push @rev_string, splice (@rev_string, -1, 1, "0")
1109 unless @rev_string == 1;
1110 }
1112 $return_rev_num = join ".", @rev_string;
1113 return $return_rev_num;
1114 }
1120 ###
1121 ###
1122 ###
1123 ###
1124 ###
1125 ### MAIN program: checks to see if there are command line parameters
1126 ###
1127 ###
1128 ###
1129 ###
1130 ###
1136 # and read the options
1137 die $usage
1138 unless GetOptions (\%options, "h|help" => \&exit_help,
1139 "recurse!", "mode|m=s", "errorfiles!", "l",
1140 "rcs-dirs|rcs-directories|r=s",
1141 "pvcs-dirs|pvcs-directories|p=s", "test-binaries|t!",
1142 "rcs-extension=s", "verify|v=s", "vcsid|i=s", "verbose!",
1143 "debug!", "force-binary!", "cvs-branch-labels!",
1144 "warnings|w!", "cvs-module-path|d=s");
1148 #
1149 # Special processing for -l !^#%$^@#$%#$
1150 #
1151 # At the moment, -l overrides --recurse, regardless of the order the
1152 # options were passed in
1153 #
1154 $options{recurse} = 0 if defined $options{l};
1155 delete $options{l};
1159 # Make sure we got acceptable values for rcs-dirs and pvcs-dirs
1160 my @hits = grep /^$options{'rcs-dirs'}/i, ("leaf", "flat");
1161 @hits == 1 or die
1162 "$0: $options{'rcs-dirs'} invalid argument to --rcs-dirs or ambiguous\n"
1163 . " abbreviation.\n"
1164 . " Must be one of: 'leaf' or 'flat'.\n"
1165 . $usage;
1166 $options{'rcs-dirs'} = $hits[0];
1167 $options{'rcs-dirs-flat'} = ($options{'rcs-dirs'} =~ /flat/);
1168 delete $options{'rcs-dirs'};
1170 @hits = grep /^$options{'pvcs-dirs'}/i, ("leaf", "flat");
1171 @hits == 1 or die
1172 "$0: $options{'pvcs-dirs'} invalid argument to --pvcs-dirs or ambiguous\n"
1173 . " abbreviation.\n"
1174 . " Must be one of: 'leaf' or 'flat'.\n"
1175 . $usage;
1176 $options{'pvcs-dirs'} = $hits[0];
1177 $options{'pvcs-dirs-flat'} = ($options{'pvcs-dirs'} =~ /flat/);
1178 delete $options{'pvcs-dirs'};
1180 # and for verify
1181 @hits = grep /^$options{verify}/i, ("none", "locks", "exists", "lockdates", "revs", "full");
1182 @hits == 1 or die
1183 "$0: $options{verify} invalid argument to --verify or ambiguous\n"
1184 . " abbreviation.\n"
1185 . " Must be one of: 'none', 'locks', 'exists', 'lockdates', 'revs',\n"
1186 . " or 'full'.\n"
1187 . $usage;
1188 $options{verify} = $hits[0];
1189 $options{verify} =~ /^none|locks|exists$/ or die
1190 "$0: --verify=$options{verify} unimplemented.\n"
1191 . $usage;
1193 # and mode
1194 @hits = grep /^$options{mode}/i, ("convert", "verify");
1195 @hits == 1 or die
1196 "$0: $options{mode} invalid argument to --mode or ambiguous abbreviation.\n"
1197 . " Must be 'convert' or 'verify'.\n"
1198 . $usage;
1199 $options{mode} = $hits[0];
1201 $options{'cvs-branch-labels'} or die
1202 "$0: RCS Branch Labels unimplemented.\n"
1203 . $usage;
1205 # export VCSID into th environment for ourselves and our children
1206 $ENV{VCSID} = $options{vcsid};
1210 #
1211 # Verify we have all the binary executables we need to run this script
1212 #
1213 # Allowed this feature to be disabled in case which is missing or we are
1214 # running on a system which does not return error codes properly (e.g. WIN95)
1215 #
1216 # -- i.e. I don't feel like grepping output yet. --
1217 #
1218 my @missing_binaries = ();
1219 if ($options{'test-binaries'})
1220 {
1221 foreach (@bin_dependancies)
1222 {
1223 my $output = qx/which $_ 2>&1/;
1224 print $output if $options{verbose} && $output;
1225 if ($? || $output =~ /^no/)
1226 {
1227 push @missing_binaries, $_;
1228 }
1229 }
1231 if (scalar @missing_binaries)
1232 {
1233 print STDERR "The following executables were not found in your PATH: "
1234 . join ( " ", @missing_binaries )
1235 . "\n"
1236 . "You must correct this before continuing.\n";
1237 exit 1;
1238 }
1239 }
1240 delete $options{'test-binaries'};
1244 #
1245 # set up our base archive manipulation commands
1246 #
1248 # set up our rcs_command mods
1249 $rcs_base_command = "rcs";
1250 $rcs_base_command .= " -x$options{'rcs-extension'}"
1251 if $options{'rcs-extension'};
1253 # set up our rcs_command mods
1254 $ci_base_command = "ci";
1255 $ci_base_command .= " -x$options{'rcs-extension'}"
1256 if $options{'rcs-extension'};
1260 #
1261 # So our logs fill in a manner we can monitor with 'tail -f' fairly easily:
1262 #
1263 STDERR->autoflush (1);
1264 STDOUT->autoflush (1);
1268 # Initialize the globals we use to keep track of recursion
1269 if ($options{recurse})
1270 {
1271 $maxlevel = 10000; # Arbitrary recursion limit
1272 }
1273 else
1274 {
1275 $maxlevel = 1;
1276 }
1277 delete $options{recurse};
1279 # So we can lock the directories behind us
1280 $donefile_name = $options{'rcs-dirs-flat'} ? "" : "RCS/";
1281 $errorfile_name = $donefile_name . "#conv.errors";
1282 $donefile_name .= "#conv.done";
1286 #
1287 # start the whole thing and drop the return code on exit
1288 #
1289 push @ARGV, "." unless (@ARGV);
1290 while ($_ = shift)
1291 {
1292 # reset the recursion level (corresponds to directory depth)
1293 # level 0 is the first directory we enter...
1294 $curlevel = -1;
1295 my ($e, $w) = execdir($_);
1296 $errors += $e;
1297 $warnings += $w;
1298 }
1302 print STDERR "$0: " . ($errors ? "Aborted" : "Done") . ".\n";
1303 print STDERR "$0: ";
1304 print STDERR ($errors ? $errors : "No") . " error" . (($errors != 1) ? "s" : "");
1305 print STDERR ", " . ($warnings ? $warnings : "no") . " warning" . (($warnings != 1) ? "s" : "")
1306 if ($options{warnings});
1307 print STDERR ".\n";
1311 #
1312 # Woo-hoo! We made it!
1313 #
1314 exit $errors;