• merge latest version of rannotate code from corecode
[alioth/cvs.git] / contrib / pvcs2rcs.in
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 #   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 #########################################################################
117
118
119
120 #
121 # USER Configurables
122 #
123
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         );
172
173 # The binaries this script is dependant on:
174 my @bin_dependancies = ("vcs", "vlog", "rcs", "ci");
175
176 # Where we should put temporary files
177 my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/var/tmp";
178
179 # We use these...
180 use strict;
181
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;
189
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 ";
196
197 my $help = "\
198 $usage
199      ----------------------------           -----------------------------------
200      -h | --Help                            Print this text
201
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
246
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)
263
264      CVS Settings
265      ----------------------------           -----------------------------------
266      ( -d | --CVS-Module-path)              Import RCS files directly into this
267                                             destination directory rather than
268                                             converting in place
269
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
276
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 ";
282
283
284
285 #
286 # Initialize globals
287 #
288
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
294
295
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         );
314
315
316
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";
327
328         print "Hit any key to continue...";
329         getc;
330
331         system "stty", "icanon", "min", "0";
332         STDOUT->autoflush (0);
333
334         print "\nI always wondered where that key was...\n";
335         }
336
337
338
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                 }
349
350         $fh->print ($usage);
351         }
352
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                 }
363
364         $fh->print ($help);
365         }
366
367 # print the help and exit $_[0] || 0
368 sub exit_help
369         {
370         print_help;
371         exit shift || 0;
372         }
373
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;
380
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++;
390
391         push @_, "something wrong.\n" unless ( @_ > 0 );
392
393         $outstring = sprintf "$0:  $type - " . join ("", @_);
394         $outstring .= sprintf " - $!\n" unless ($outstring =~ /\n$/);
395
396         print STDERR $outstring;
397
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                 }
414
415         return $$error_count_ref;
416         }
417
418
419
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;
426
427         local ($_, @_);
428
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;
449
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                         }
465
466                 # clean up by closing the directory
467                 closedir(CURDIR);
468
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                         }
492
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                 }
507
508         # save the current directory
509         $cd = cwd;
510
511         # increment the global $curlevel variable
512         $curlevel = $curlevel +1;
513
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);
518
519         # print "$cd:  " . join (", ", @filenames) . "\n";
520         # hit_any_key;
521
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                                 }
544
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});
548
549                                 $vcsdir = $fn;
550
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;
557
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                                         }
564
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                 }
593
594         # print "pvcsarchives:  " . join (", ", @pvcsarchives) . "\n";
595         # print "subdirs:  " . join (", ", @subdirs) . "\n";
596         # hit_any_key;
597
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                 }
609
610         # Print output header for each directory
611         print("Directory: $cd\n");
612
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                 }
625
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;
633
634                 my $abs_file = $cd . "/" . $pvcsarchive;
635
636                 print("Verifying $abs_file...\n") if ($options{verbose});
637
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\"`;
642
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                         }
652
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];
662
663                         if( ( /^Workfile:\s*/ ) && (!$got_workfile ) )
664                                 {
665                                 my $num_fields;
666
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                                         }
675
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                                 }
681
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                                 }
689
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                                 }
696
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                                 }
704
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+$/);
717
718                                         $_ = $vlog_strings[$num+1];
719                                         /^\s*Locked\s*/ and $num++;
720
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});
725
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});
731
732                                         my @branches = ();
733                                         $_ = $vlog_strings[$num+1];
734                                         if (/^\s*Branches:\s*/)
735                                                 { 
736                                                 $num++;
737                                                 @branches = split /\s+/, $';
738                                                 }
739
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}$/;
748
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;
763
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                         }
782
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;
789
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});
805
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                         }
817                 
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                         }
835
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\"`;
846
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);
850
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                                         }
863
864                                 # FIXME: Doesn't handle quotes and other special characters in
865                                 #        filenames as two FIXMEs above.
866                                 $rcs_command .= " \"$workfile\"";
867
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;
875
876                                 # $rcs_output = `$rcs_base_command -i -kb $workfile`;
877                                 }
878
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;
888
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                         }
897
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";
903
904                         $ci_command = $ci_base_command;
905                         $ci_command .= " -f -r$rcs_rev_num{$revision} -d$checked_in{$revision}"
906                                         . " -w$author{$revision}";
907
908                         $ci_command .= " \"$workfile\"";
909
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`;
919
920                         $first_time = 0 if ($first_time);
921                         } # foreach revision
922
923                 # Keep track of 1.*, 2.*, etc. branches as they are created.
924                 my %trunk_branches;
925
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";
933
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                         }
970
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";
973
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                         }
982
983                         } # foreach label
984
985                 if ($options{'cvs-module-path'})
986                 {
987                                 print "Moving $rcsarchive to $cvsarchive\n";
988                                 move $rcsarchive, $cvsarchive or warn "Move failed: $!";
989                 }
990
991                 # hit_any_key;
992                 } # foreach pvcs archive file
993
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                 }
1011
1012         $curlevel = $curlevel - 1;
1013
1014         chdir $old_dir
1015                 or die "Failed to restore original directory ($old_dir): ", $!, ", stopped";
1016
1017         # Update the relative directory path.
1018         pop @rel_dirs if -d $dir;
1019
1020         return ($errors, $warnings);
1021         }
1022
1023
1024
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);
1041
1042         die "Not enough arguments to revisions : a = ", join (".", @a),
1043                         "; b = ", join (".", @b), ", stopped"
1044                 unless (@a and @b);
1045
1046         for ($i = 0; $i < scalar( @a ) && $i < scalar( @b ); $i++)
1047                 {
1048                 $a[$i] == $b[$i] or return ($a[$i] <=> $b[$i]);
1049                 }
1050
1051         return 0 if (scalar (@a) == scalar (@b));
1052
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         }
1066
1067
1068
1069 sub pvcs_to_rcs_rev_number
1070         {
1071         my($input, $num_fields, @rev_string, $return_rev_num, $i);
1072
1073         $input = $_[0];
1074         $num_fields = split /\./, $input;
1075         @rev_string = @_;
1076         # @rev_string[$num_fields-1] += 1;
1077
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                 }
1095
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                 }
1111
1112         $return_rev_num = join ".", @rev_string;
1113         return $return_rev_num;
1114         }
1115
1116
1117
1118
1119
1120 ###
1121 ###
1122 ###
1123 ###
1124 ###
1125 ###   MAIN program: checks to see if there are command line parameters
1126 ###
1127 ###
1128 ###
1129 ###
1130 ###
1131
1132
1133
1134
1135         
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");
1145
1146
1147
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};
1156
1157
1158
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'};
1169
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'};
1179
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;
1192
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];
1200
1201 $options{'cvs-branch-labels'} or die
1202                   "$0: RCS Branch Labels unimplemented.\n"
1203                 . $usage;
1204
1205 # export VCSID into th environment for ourselves and our children
1206 $ENV{VCSID} = $options{vcsid};
1207
1208
1209
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                 }
1230
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'};
1241
1242
1243
1244 #
1245 # set up our base archive manipulation commands
1246 #
1247
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'};
1252
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'};
1257
1258
1259
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);
1265
1266
1267
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};
1278
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";
1283
1284
1285
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         }
1299
1300
1301
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";
1308
1309
1310
1311 #
1312 # Woo-hoo!  We made it!
1313 #
1314 exit $errors;