diff options
Diffstat (limited to 'contrib/pvcs2rcs.in')
| -rw-r--r-- | contrib/pvcs2rcs.in | 1314 |
1 files changed, 1314 insertions, 0 deletions
diff --git a/contrib/pvcs2rcs.in b/contrib/pvcs2rcs.in new file mode 100644 index 0000000..ac36ddc --- /dev/null +++ b/contrib/pvcs2rcs.in @@ -0,0 +1,1314 @@ +#! @PERL@ +# --------------------------------- +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +########################################################################### +# FUNCTION: +# To recursively walk through a PVCS archive directory tree (archives +# located in VCS/ or vcs/ subdirectories) and convert them to RCS archives. +# The RCS archive name is the PVCS workfile name with ",v" appended. +# +# SYNTAX: +# pvcs_to_rcs.pl --help +# +# where -l indicates the operation is to be performed only in the current +# directory (no recursion) +# +# EXAMPLE: +# pvcs_to_rcs +# Would walk through every VCS or vcs subdir starting at the current directory, +# and produce corresponding RCS archives one level above the VCS or vcs subdir. +# (VCS/../RCS/) +# +# NOTES: +# * This script performs little error checking and logging +# (i.e. USE AT YOUR OWN RISK) +# * This script was last tested using ActiveState's port of Perl 5.005_02 +# (internalcut #507) under Win95, though it does compile under Perl-5.00404 +# for Solaris 2.4 run on a Solaris 2.6 system. The script crashed +# occasionally under ActiveState's port of Perl 5.003_07 but this stopped +# happening with the update so if you are having problems, try updating Perl. +# Upgrading to cut #507 also seemed to coincide with a large speed +# improvement, so try and keep up, hey? :) It was executed from MKS's +# UNIX tools version 6.1 for Win32's sh. ALWAYS redirect your output to +# a log!!! +# * PVCS archives are left intact +# * RCS archives are created in VCS/../RCS/ (or ./RCS using '-pflat') +# * Branch labels in this script will be attached to the CVS magic +# revision number. For branch a.b.c of a particular file, this means +# the label will be attached to revision a.b.0.c of the converted +# file. If you use the TrunkTip (1.*) label, be aware that it will convert +# to RCS revision 0.1, which is useless to RCS and CVS. You'll probably +# have to delete these. +# * All revisions are saved with correct "metadata" (i.e. check-in date, +# author, and log message). Any blank log message is replaced with +# "no comment". This is because RCS does not allow non-interactive +# check in of a new revision without a comment string. +# * Revision numbers are incremented by 1 during the conversion (since +# RCS does not allow revision 1.0). +# * All converted branch numbers are even (the CVS paradigm) +# * Version labels are assigned to the appropriate (incremented) revision +# numbers. PVCS allows spaces and periods in version labels while RCS +# does not. A global search and replace converts " " and "." to "_" +# There may be other cases that ought to be added. +# * Any working (checked-out) copies of PVCS archives +# within the VCS/../ or vcs/../ (or possibly ./ with '-pflat') +# will be deleted (or overwritten) depending on your mode of +# operation since the current ./ is used in the checkout of each revision. +# I suppose if development continues these files could be redirected to +# temp space rather than ./ . +# * Locks on PVCS archives should be removed (or the workfiles should be +# checked-in) prior to conversion, although the script will blaze through +# the archive nonetheless (But you would lose any checked out revision(s)) +# * The -kb option is added to the RCS archive for workfiles with the following +# extensions: .bin .out .btl .rom .a07 .lib .exe .tco .obj .t8u .c8u .o .lku +# .a and a few others. The %bin_ext variable holds these values in regexp +# form. +# * the --force-binary option can be used to convert binary files which don't +# have proper extensions, but I'd *probably* edit the %bin_ext variable. +# * This script will abort occasionally with the error "invalid revision +# number". This is known to happen when a revision comment has +# /^\s*Rev/ (Perl regexp notation) in it. Fix the comment and start over. +# (The directory locks and existance checking make this a fairly quick +# process.) +# Binary files which do not have their mode set properly are likely to look +# corrupted on initial checkout and use, but using +# `cvs admin -kb <workfilename>' to retroactively change the RCS keyword +# substitution mode of the file to binary (and refreshing the files in any +# local workspaces they are checked out in: `rm <workfilename>; update' +# should do the trick) should end any problems with the original import. +# If anyone has checked in changes since the import, those revisions may +# be corrupted in the imported archive and therefore those changes (commits +# of corrupted data) may need to be backed out. +# * This script writes lockfiles in the RCS/ directories. It will also not +# convert an archive if it finds the RCS Archive existant in the RCS/ +# directory. This enables the conversion to quickly pick up where it left +# off after errors or interrupts occur. If you interrupt the script make +# sure you delete the last RCS Archive File which was being written. +# If you recieve the "Invalid revision number" error, then the RCS archive +# file for that particular PVCS file will not have been created yet. +# * This script will not create lockfiles when processing single +# filenames passed into the script, for hopefully obvious reasons. +# (lockfiles lock directories - DRP) +# * Log the output to a file. That makes it real easy to grep for errors +# later. (grep for "^[ \t]*(rcs|ci):" and be aware I might have missed +# a few cases (get? vcs?) !!!) *** Also note that this script will +# exibit some harmless RCS errors. Namely, it will attempt to lock +# branches which haven't been created yet. *** +# * I tried to keep the error and warning info up to date, but it seems +# to mean very little. This script almost always exits with a warning +# or an error that didn't seem to cause any harm. I didn't trace it +# and our imported source checks out and builds... +# It is probably happening when trying to convert empty directories +# or read files (possibly checked out workfiles ) which are not +# pvcs_archives. +# * You must use the -pflat option when processing single filenames +# passed as arguments to the script. This is probably a bug. +# * questions, comments, additions can be sent to info-cvs@nongnu.org +######################################################################### + + + +# +# USER Configurables +# + +# %bin_ext should be editable from the command line. +# +# NOTE: Each possible binary extension is listed as a Perl regexp +# +# The value associated with each regexp key is used to print a log +# message when a binary file is found. +my %bin_ext = + ( + '\.(?i)abs$' => "Absolute File", + '\.(?i)bin$' => "Binary", + '\.(?i)bit$' => "Bit File", + '\.(?i)ol$' => "Compiler Output", + '\.(?i)out$' => "Default Compiler Output", + '\.(?i)ln$' => "Linker Output", + '\.(?i)lob$' => "Lint Output", + '\.(?i)zob$' => "DBCO Object", + '\.(?i)mim$' => "MIME File", + '\.(?i)dwi$' => "DWI File", + '\.(?i)iop$' => "IOP File", + '\.(?i)btl$' => "", + '\.(?i)rom$' => "ROM File", + '\.(?i)a07$' => "", + '\.(?i)lib$' => "DOS/Wintel/Netware Compiler Library", + '\.(?i)lif$' => "Netware Binary File", + '\.(?i)(com|exe)$' => "DOS/Wintel Executable", + '\.(?i)tco$' => "", + '\.(?i)obj$' => "DOS/Wintel Compiler Object", + '\.(?i)res$' => "DOS/Wintel Resource File", + '\.(?i)ico$' => "DOS/Wintel Icon File", + '\.(?i)nlm$' => "Netware Loadable Module", + '\.(?i)t8u$' => "", + '\.(?i)c8u$' => "", + '\.(?i)lku$' => "", + '\.(?i)pdf$' => "Adobe Acrobat Portable Document Format", + '\.(?i)doc$' => "MS Word Document", + '\.(?i)dot$' => "MS Word Document Template", + '\.(?i)pps$' => "MS PowerPoint Presentation", + '\.(?i)xls$' => "MS Excel Spreadsheet", + '\.(?i)(bmp|gif|jfif|jpeg|jpg|png|tif|tiff|xbm)$' => "Image", + '\.(?i)(bz2|gz|tgz|zip)$' => "Compressed File", + '\.(?i)dll$' => "DOS/Wintel Dynamically Linked Library", + '\.(?i)class$' => "Compliled Java Class File", + '\.(?i)jar$' => "Java Archive File", + '\.(?i)war$' => "Java Web Archive File", + '\.o$' => "UNIX Compiler Object", + '\.a$' => "UNIX Compiler Library", + '\.so(\.\d+\.\d+)?$' => "UNIX Shared Library" + ); + +# The binaries this script is dependant on: +my @bin_dependancies = ("vcs", "vlog", "rcs", "ci"); + +# Where we should put temporary files +my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/var/tmp"; + +# We use these... +use strict; + +use Cwd; +use File::Basename; # For the usage message. +use File::Copy; +use File::Path; +use IO::File; +use Getopt::Long; + $Getopt::Long::bundling = 1; + +my $program = basename $0; +my $usage = "\ +usage: $program -h + $program [-lt] [-i vcsid] [-r flat|leaf] [-p flat|leaf] + [-x rcs_extension] [-v none|locks|exists] [options] [path...] +"; + +my $help = "\ +$usage + ---------------------------- ----------------------------------- + -h | --Help Print this text + + General Settings + ---------------------------- ----------------------------------- + --Recurse Recurse through directories + (default) + -l | --NORecurse Process only . + --Errorfiles Save a count of conversion errors + in the RCS archive directory + (default) (unimplemented) + --NOErrorfiles Don't save a count of conversion + errors (unimplemented) + ( -m | --Mode ) Convert Convert PVCS files to RCS files + (default) + ( -m | --Mode ) Verify Perform verification ONLY + (unimplemented) + ( -v | --VERIfy ) None Always replace existing RCS files + ( -v | --VERIfy ) LOCKS Same as exists unless a #conv.done + file exists in the RCS directory. + In that case, only the #conv.done + file's existance is verified for + that directory. (default) + ( -v | --VERIfy ) Exists Don't replace existing RCS files + ( -v | --VERIfy ) LOCKDates Verify that an existing RCS file's + last modification date is older + than that of the lockfile + (unimplemented) + ( -v | --VERIfy ) Revs Verify that the PVCS archive files + and RCS archive file contain the + same number of corresponding + revisions. Add only new revisions + to the RCS file. (unimplemented) + ( -v | --VERIfy ) Full Perform --verify=Revs and confirm + that the text of the revisions is + identical. Add only new revisions + unless an error is found. Then + erase the RCS archive and recreate + it. (unimplemented) + -t | --Test-binaries Use 'which' to check \$PATH for + the binaries required by this + script (default) + --NOTest-binaries Don't check for binaries + --VERBose Enable verbose output + --NOVerbose Disable verbose output (default) + -w | --Warnings Print warning messages (default) + --NOWarnings Don't print warning messages + + RCS Settings + ---------------------------- ----------------------------------- + ( -r | --RCS-Dirs ) leaf RCS files stored in ./RCS (default) + ( -r | --RCS-Dirs ) flat RCS files stored in . + (unimplemented) + ( -x | --RCS-Extension ) Set RCS file extension + (default = ',v') + --Force-binary Pass '-kb' to 'rcs -i' regardless + of the file extension + --NOForce-binary Only use '-kb' when the file has + a binary extension (default) + --CVS-Branch-labels Use CVS magic branch revision + numbers when attaching branch + labels (default) + --NOCvs-branch-labels Attach branch labels to RCS branch + revision numbers (unimplemented) + + CVS Settings + ---------------------------- ----------------------------------- + ( -d | --CVS-Module-path) Import RCS files directly into this + destination directory rather than + converting in place + + PVCS Settings + ---------------------------- ----------------------------------- + ( -p | --Pvcs-dirs ) leaf PVCS files expected in ./VCS + (default) + ( -p | --Pvcs-dirs ) flat PVCS files expected in . + ( -i | --VCsid ) vcsid Use vcsid instead of \$VCSID + + -------------------------------------------------------------------------- + The optional path argument should contain the name of a file or directory + to convert. If not given, it will default to '.'. + -------------------------------------------------------------------------- +"; + + + +# +# Initialize globals +# + +my ($errors, $warnings) = (0, 0); +my ($curlevel, $maxlevel); +my ($rcs_base_command, $ci_base_command); +my ($donefile_name, $errorfile_name); +my @rel_dirs = (); # list of relative directory names up to current dir + + +# set up the default options +my %options = ( + 'recurse' => 1, + 'mode' => "convert", + 'errorfiles' => 1, + 'rcs-dirs' => "leaf", + 'rcs-extension' => ",v", + 'force-binary' => 0, + 'cvs-branch-labels' => 1, + 'cvs-module-path' => undef, + 'pvcs-dirs' => "leaf", + 'verify' => "locks", + 'test-binaries' => 1, + 'vcsid' => $ENV{VCSID} || "", + 'verbose' => 0, + 'debug' => 0, + 'warnings' => 1 + ); + + + +# This is untested except under Solaris 2.4 or 2.6 and +# may not be portable +# +# I think the readline lib or some such has an interface +# which may enable this now. The perl installer sure looks +# like it's testing this kind of thing, anyhow. +sub hit_any_key + { + STDOUT->autoflush; + system "stty", "-icanon", "min", "1"; + + print "Hit any key to continue..."; + getc; + + system "stty", "icanon", "min", "0"; + STDOUT->autoflush (0); + + print "\nI always wondered where that key was...\n"; + } + + + +# print the usage +sub print_usage + { + my $fh = shift; + unless (ref $fh) + { + my $fdn = $fh ? $fh : "STDERR"; + $fh = new IO::File; + $fh->fdopen ($fdn, "w"); + } + + $fh->print ($usage); + } + +# print the help +sub print_help + { + my $fh = shift; + unless (ref $fh) + { + my $fdn = $fh ? $fh : "STDOUT"; + $fh = new IO::File; + $fh->fdopen ($fdn, "w"); + } + + $fh->print ($help); + } + +# print the help and exit $_[0] || 0 +sub exit_help + { + print_help; + exit shift || 0; + } + +sub error_count + { + my $type = shift + or die "$0: error - error_count usage: error_count type [, ref] [, LIST]\n"; + my $error_count_ref; + my $outstring; + + if (ref ($_[0]) && ref ($_[0]) == "SCALAR") + { + $error_count_ref = shift; + } + else + { + $error_count_ref = \$errors; + } + $$error_count_ref++; + + push @_, "something wrong.\n" unless ( @_ > 0 ); + + $outstring = sprintf "$0: $type - " . join ("", @_); + $outstring .= sprintf " - $!\n" unless ($outstring =~ /\n$/); + + print STDERR $outstring; + + if ($options{errorfiles}) + { + my $fh = new IO::File ">>$errorfile_name" or new IO::File ">$errorfile_name"; + if ($fh) + { + $fh->print ($$error_count_ref . "\n"); + $fh->print ($outstring); + $fh->close; + } + else + { + my $cd = cwd; + print STDERR "$0: error - failed to open errorfile $cd/$errorfile_name - $!\n" + if ($options{debug}); + } + } + + return $$error_count_ref; + } + + + +# the main procedure that is run once in each directory +sub execdir + { + my $dir = shift; + my ($errors, $warnings) = (0, 0); # We return these error counters + my $old_dir = cwd; + + local ($_, @_); + + my $i; # Generic counter + my ($pvcsarchive, $workfile, $rcsarchive); # .??v, checked out file, and ,v files, + # respectively + my ($rev_count, $first_vl, $last_vl, $description, + $rev_index, @rev_num, %checked_in, %author, + $relative_comment_index, @comment_string, + %comment); + my ($num_version_labels, $label_index, @label_revision, $label, + @new_label, $rcs_rev); + my ($revision, %rcs_rev_num); + my @remainder; + my ($get_output, $rcs_output, $ci_output, $mv_output); + my ($ci_command, $rcs_command, $wtr); + my @hits; + my ($num_fields); + my $skipdirlock; # if true, don't write conv.out + # used only for single file operations + # at the moment + my $cd; + my $cvs_dir; + + my @filenames; + # We may have recieved a single file name to process... + if ( -d $dir ) + { + # change into the directory to be processed + # open the current directory for listing + # initialize the list of filenames + # and set filenames equal to directory listing + unless ( ( chdir $dir ) and ( opendir CURDIR, "." ) and ( @filenames = readdir CURDIR ) ) + { + $cd = cwd; + error_count 'error', \$errors, "skipping directory $dir from $cd"; + chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped"; + return ($errors, $warnings); + } + + # clean up by closing the directory + closedir(CURDIR); + + if ($options{'rcs-dirs-flat'} && $options{'cvs-module-path'}) + { + my @cur_dir_names = split qr{[/\\]}, cwd; + my $rel_cd = $cur_dir_names[-1]; + push @rel_dirs, $rel_cd; + $cvs_dir = "$options{'cvs-module-path'}/" + . join "/", @rel_dirs; + if (!-d $cvs_dir) + { + print "Creating directory \`$cvs_dir'\n"; + if (!mkpath ($cvs_dir)) + { + pop @rel_dirs; + error_count 'error', \$errors, +"failed to make directory \`$cvs_dir' - skipping directory \`$cd'"; + chdir $old_dir or die +"Failed to restore original directory (\`$old_dir'): ", $!, ", stopped"; + return ($errors, $warnings); + # after all, we have nowhere to put + # them... + } + } + } + + } + elsif ( -f $dir ) # we recieved a single file + { + push @filenames, $dir; + $skipdirlock = 1; + } + else + { + $cd = cwd; + error_count 'error', \$errors, "no such directory/file $dir from $cd\n"; + chdir $old_dir or die +"Failed to restore original directory ($old_dir): ", $!, ", stopped"; + return ($errors, $warnings); + } + + # save the current directory + $cd = cwd; + + # increment the global $curlevel variable + $curlevel = $curlevel +1; + + # initialize a list for any subdirectories and any files + # we need to process + my $vcsdir = ""; + my (@subdirs, $fn, $file, @files, @pvcsarchives); + + # print "$cd: " . join (", ", @filenames) . "\n"; + # hit_any_key; + + (@files, @pvcsarchives) = ( (), () ); + # begin a for loop to execute on each filename in the list @filename + foreach $fn (@filenames) + { + # if the file is a directory... + if (-d $fn) + { + # then if we are not expecting a flat arrangement of pvcs files + # and we found a vcs directory add its files to @pvcsarchives + if (!$options{'pvcs-dirs-flat'} and $fn =~ /^vcs$/i) + { + if ($options{verify} =~ /^locks$/ ) { + if ( -f $donefile_name ) { + print "Verified existence of lockfile $cd/$donefile_name." + . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" ) + . "\n" if ($options{verbose}); + next; + } elsif ( $options{mode} =~ /^verify$/ ) { + print "No lockfile found for $cd .\n"; + next; + } + } + + # else add the files in the vcs dir to our list of files to process + error_count 'warning', \$warnings, "Found two vcs dirs in directory $cd.\n" + if ($vcsdir and $options{warnings}); + + $vcsdir = $fn; + + unless ( ( opendir VCSDIR, $vcsdir ) and ( @files = readdir VCSDIR ) ) + { + error_count 'error', \$errors, "skipping directory &cd/$fn"; + next; + } + closedir VCSDIR; + + # and so we don't need to worry about where these + # files came from later... + foreach $file (@files) + { + push @pvcsarchives, "$vcsdir/$file" if (-f "$vcsdir/$file"); + } + + # don't want recursion here... + @pvcsarchives = grep !/^\.\.?$/, @pvcsarchives; + } + elsif ($fn !~ /^\.\.?$/) + { + next if (!$options{'rcs-dirs-flat'} and $fn =~ /^rcs$/i); + # include it in @subdir if it's not a parent directory + push(@subdirs,$fn); + } + } + # else if we are processing a flat arrangement of pvcs files... + elsif ($options{'pvcs-dirs-flat'} and -f $fn) + { + if ($options{verify} =~ /^locks$/) { + if ( -f $donefile_name) { + print "Found lockfile $cd/$donefile_name." + . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" ) + . "\n" if ($options{verbose}); + last; + } elsif ($options{mode} =~ /^verify$/) { + print "No lockfile found for $cd .\n"; + last; + } + } + # else add this to the list of files to process + push (@pvcsarchives, $fn); + } + } + + # print "pvcsarchives: " . join (", ", @pvcsarchives) . "\n"; + # print "subdirs: " . join (", ", @subdirs) . "\n"; + # hit_any_key; + + # for loop of subdirs + foreach (@subdirs) + { + # run execdir on each sub dir + if ($maxlevel >= $curlevel) + { + my ($e, $w) = execdir ($_); + $errors += $e; + $warnings += $w; + } + } + + # Print output header for each directory + print("Directory: $cd\n"); + + # the @files variable should already contain the list of files + # we should attempt to process + if ( @pvcsarchives && ( $options{mode} =~ /^convert$/ ) ) + { + # create an RCS directory in parent to store RCS files in + if ( !( $options{'rcs-dirs-flat'} or (-d "RCS") or mkpath ( "RCS" ) ) ) + { + error_count 'error', \$errors, "failed to make directory $cd/RCS - skipping directory $cd"; + @pvcsarchives = (); + # after all, we have nowhere to put them... + } + } + + # begin a for loop to execute on each filename in the list @files + foreach $pvcsarchive (@pvcsarchives) + { + my $got_workfile = 0; + my $got_version_labels = 0; + my $got_description = 0; + my $got_rev_count = 0; + + my $abs_file = $cd . "/" . $pvcsarchive; + + print("Verifying $abs_file...\n") if ($options{verbose}); + + print "vlog $pvcsarchive\n"; + # FIXME: Quoting this is better than no quotes, but quotes in + # filenames remain unquoted. + my $vlog_output = `vlog \"$pvcsarchive\"`; + + # Split the vcs status output into individual lines + my @vlog_strings = split /\n/, $vlog_output; + my $num_vlog_strings = @vlog_strings; + $_ = $vlog_strings[0]; + if ( /^\s*$/ || /^vlog: warning/ ) + { + error_count 'warning', \$warnings, "$abs_file is NOT a valid PVCS archive!!!\n"; + next; + } + + my $num; + # Collect all vlog output into appropriate variables + # + # This will ignore at the very least the /^\s*Archive:\s*/ field + # and maybe more. This should not be a problem. + for ( $num = 0; $num < $num_vlog_strings; $num++ ) + { + # print("$vlog_strings[$num]\n"); + $_ = $vlog_strings[$num]; + + if( ( /^Workfile:\s*/ ) && (!$got_workfile ) ) + { + my $num_fields; + + $got_workfile = 1; + # get the string to the right of the above search (with any path stripped) + $workfile = $'; + $num_fields = split /[\/\\]/, $workfile; + if ( $num_fields > 1 ) + { + $workfile = $_[$num_fields - 1 ]; + } + + $rcsarchive = $options{'rcs-dirs-flat'} ? "" : "RCS/"; + $rcsarchive .= $workfile; + $rcsarchive .= $options{'rcs-extension'} if ($options{'rcs-extension'}); + print "Workfile is $workfile\n" if ($options{debug}); + } + + elsif ( ( /^Rev count:\s*/ ) && (!$got_rev_count ) ) + { + $got_rev_count = 1; + # get the string to the right of the above search + $rev_count = $'; + print "Revision count is $rev_count\n"; + } + + elsif ( ( /^Version labels:\s*/ ) && (!$got_version_labels ) ) + { + $got_version_labels = 1; + $first_vl = $num+1; + print "Version labels start at $first_vl\n" if ($options{debug}); + } + + elsif ( ( /^Description:\s*/ ) && (!$got_description ) ) + { + $got_description = 1; + $description = $vlog_strings[$num+1]; + print "Description is `$description'\n" if ($options{debug}); + $last_vl = $num++ - 1; + } + + elsif ( /^Rev\s+/ ) # get all the revision information at once + { + $rev_index = 0; + @rev_num = (); + while ( $rev_index < $rev_count ) + { + $_ = $vlog_strings[$num]; + /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/; + $rev_num[$rev_index] = $1; + print "Found revision: $rev_num[$rev_index]\n" if ($options{debug}); + die "Not a valid revision ($rev_num[$rev_index]).\n" + if ($rev_num[$rev_index] !~ /^(\d+\.)(\d+\.\d+\.)*\d+$/); + + $_ = $vlog_strings[$num+1]; + /^\s*Locked\s*/ and $num++; + + $_ = $vlog_strings[$num+1]; + /^\s*Checked in:\s*/; + $checked_in{$rev_num[$rev_index]} = "\"" . $' . "\""; + print "Checked in: $checked_in{$rev_num[$rev_index]}\n" if ($options{debug}); + + $_ = $vlog_strings[$num+3]; + /^\s*Author id:\s*/; + my @fields = split; + $author{$rev_num[$rev_index]} = "\"" . $fields[2] . "\""; + print "Author: $author{$rev_num[$rev_index]}\n" if ($options{debug}); + + my @branches = (); + $_ = $vlog_strings[$num+1]; + if (/^\s*Branches:\s*/) + { + $num++; + @branches = split /\s+/, $'; + } + + $relative_comment_index = 0; + @comment_string = (); + while (($num + 4 + $relative_comment_index) < @vlog_strings) + { + last if $vlog_strings[$num+4+$relative_comment_index] + =~ /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/ + && $vlog_strings[$num+3+$relative_comment_index] + =~ /^-{35}$/; + + # We need the \n added for multi-line comments. There is no effect for + # single-line comments since RCS inserts the \n if it doesn't exist already + # print "Found commment line: $vlog_strings[$num+4+$relative_comment_index]\n" + # if ($options{debug}); + push @comment_string, $vlog_strings[$num+4+$relative_comment_index], "\n"; + $relative_comment_index += 1; + } + # print "Popped from comment: " . join ("", splice (@comment_string, -2)) + # . "\n" + # if ($options{debug}); + # Pop the "-+" or "=+" line from the comment + while ( (pop @comment_string) !~ /^-{35}|={35}$/ ) + {} + $comment{$rev_num[$rev_index]} = join "", @comment_string; + + $num += ( 4 + $relative_comment_index ); + print "Got comment for $rev_num[$rev_index]\n" if ($options{debug}); + print "comment string: $comment{$rev_num[$rev_index]}\n" if ($options{debug}); + $rev_index += 1; + } # while ( $rev_index < $rev_count ) + $num -= 1; #although there should be nothing left for this to matter + } # Get Rev information + } # for ($num = 0; $num < $num_vlog_strings; $num++) + # hit_any_key if ($options{debug}); + # Create RCS revision numbers corresponding to PVCS version numbers + my @rcs_rev_nums; + foreach $revision (@rev_num) + { + $rcs_rev_num{ $revision } = &pvcs_to_rcs_rev_number( $revision ); + push @rcs_rev_nums, $rcs_rev_num{$revision}; + print"PVCS revision is $revision; RCS revision is $rcs_rev_num{ $revision }\n" + if ($options{debug}); + } + + # Sort the revision numbers - PVCS and RCS store them in different orders + # Clear @_ so we don't pass anything in by accident... + @_ = (); + @rev_num = sort revisions @rev_num; + print "Sorted rev_nums:\n" . join ("\n", @rev_num) . "\n" if ($options{debug}); + # hit_any_key; + + # Loop through each version label, checking for need to relabel ' ' with '_'. + $num_version_labels = $last_vl - $first_vl + 1; + print "Version label count is $num_version_labels\n"; + for( $i = $first_vl; $i <= $last_vl; $i += 1 ) + { + # print("$vlog_strings[$i]\n"); + $label_index = $i - $first_vl; + $_=$vlog_strings[$i]; + print "Starting with string '$_'\n" if ($options{debug}); + my @fields = split /\"/; + $label = $fields[1]; + print "Got label '$label'\n" if ($options{debug}); + @fields = split /\s+/, $fields[2]; + $label_revision[$label_index] = $fields[2]; + print "Original label is $label_revision[$label_index]\n" if ($options{debug}); + + # Create RCS revision numbers corresponding to PVCS version numbers by + # adding 1 to the revision number (# after last .) + $label_revision[ $label_index ] = pvcs_to_rcs_rev_number( $label_revision [ $label_index ] ); + # replace ' ' with '_', if needed + $_=$label; + $new_label[$label_index] = $label; + $new_label[$label_index] =~ s/ /_/g; + $new_label[$label_index] =~ s/\./_/g; + $new_label[$label_index] = "\"" . $new_label[$label_index] . "\""; + print"Label $new_label[$label_index] is for revision $label_revision[$label_index]\n" if ($options{debug}); + } + + ########## + # + # See if the RCS archive is up to date with the PVCS archive + # + ########## + my $cvsarchive; + $cvsarchive = "$cvs_dir/$rcsarchive" if $options{'cvs-module-path'}; + $cvsarchive .= $rcsarchive; + if ($options{verify} =~ /^locks|exists$/ and -f $cvsarchive) + { + print "Verified existence of " + . ($options{'cvs-module-path'} ? $cvsarchive : "$cd/$rcsarchive") + . "." + . ( ($options{mode} =~ /^convert$/) ? " Skipping." : "" ) + . "\n" if ($options{verbose}); + next; + } + + # Create RCS archive and check in all revisions, then label. + my $first_time = 1; + foreach $revision (@rev_num) + { + # print "get -p$revision $pvcsarchive >$workfile\n"; + print "get -r$revision $pvcsarchive\n"; + # $vcs_output = `vcs -u -r$revision $pvcsarchive`; + # $get_output = `get -p$revision $pvcsarchive >$workfile`; + # FIXME: Doesn't handle quotes in filenames as FIXME above. + $get_output = `get -r$revision \"$pvcsarchive\"`; + + # if this is the first time, delete the rcs archive if it exists + # need for $options{verify} == none + unlink $rcsarchive if ($first_time and $options{verify} =~ /^none$/ and -f $rcsarchive); + + # Also check here whether this file ought to be "binary" + if ( $first_time ) + { + $rcs_command = "$rcs_base_command -i"; + if ( ( @hits = grep { $workfile =~ /$_/ } keys %bin_ext ) || $options{'force-binary'} ) + { + $rcs_command .= " -kb"; + $workfile =~ /$hits[0]/ if (@hits); + print "Binary attribute -kb added (" + . (@hits ? "file type is '$bin_ext{$hits[0]}' for extension '$&'" : "forced") + . ")\n"; + } + + # FIXME: Doesn't handle quotes and other special characters in + # filenames as two FIXMEs above. + $rcs_command .= " \"$workfile\""; + + # print and execute the rcs archive initialization command + print "$rcs_command\n"; + $wtr = new IO::File "|$rcs_command"; + $wtr->print ($description); + $wtr->print ("\n") unless ($description =~ /\n$/s); + $wtr->print (".\n"); + $wtr->close; + + # $rcs_output = `$rcs_base_command -i -kb $workfile`; + } + + # if this isn't the first time, we need to lock the rcs branch + # + # This is a little messy, but it works. Some extra locking is attempted. + # (This happens the first time a branch is used, at the least) + my $branch = ""; + my @branch; + @branch = split /\./, $rcs_rev_num{$revision}; + pop @branch; + $branch = join ".", @branch if @branch != 1; + + # FIXME: Quotes around file names handles spaces but not shell + # metacharacters in file names. + unless ($first_time) + { + print "$rcs_base_command -l$branch \"$workfile\"\n" + if $options{'debug'}; + $rcs_output = `$rcs_base_command -l$branch \"$workfile\"`; + } + + # If an empty comment is specified, RCS will not check in the file; + # check for this case. (but an empty -t- description is fine - go figure!) + # Since RCS will pause and ask for a comment if one is not given, + # substitute a dummy comment "no comment". + $comment{$revision} =~ /^\s*$/ and $comment{$revision} = "no comment\n"; + + $ci_command = $ci_base_command; + $ci_command .= " -f -r$rcs_rev_num{$revision} -d$checked_in{$revision}" + . " -w$author{$revision}"; + + $ci_command .= " \"$workfile\""; + + # print and execute the ci command + print "$ci_command\n"; + $wtr = new IO::File "|$ci_command"; + $wtr->print ($comment{$revision}); + $wtr->print ("\n") unless ($comment{$revision} =~ /\n$/s); + $wtr->print (".\n"); + $wtr->close; + # $ci_output = `$ci_command`; + # $ci_output = `cat $tmpdir/ci.out`; + + $first_time = 0 if ($first_time); + } # foreach revision + + # Keep track of 1.*, 2.*, etc. branches as they are created. + my %trunk_branches; + + # Attach version labels + for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 ) + { + print "$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"\n" + if $options{'debug'}; + $rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`; + print "Version label $new_label[$i] added to revision $label_revision[$i]\n"; + + # If the label revision is attached to a 1.* revision on the trunk + # when a 2.* revision exists, then 1.MAX needs to be branched to + # allow commits to this label. This applies to 2.* when 3.* + # exists, as well. + if ($label_revision[$i] !~ /\./) + { + # This revision is attached to the trunk. + # $rcs_rev_nums[0] will always be the max revision. + print "Label `$new_label[$i]' moved from $label_revision[$i] to "; + if (exists $trunk_branches{$label_revision[$i]}) + { + $label_revision[$i] = $trunk_branches{$label_revision[$i]}; + } + else + { + # Attached to X.* with X < M + my @X_revs = grep /^$label_revision[$i]\./, @rcs_rev_nums; + # Need a _NEW_ branch from $X_revs[0] to attach + # to. CVS could do this easily, but our archive + # isn't in a CVS repository yet. + my @tmp_lbl = @label_revision; + my @branch_nums = grep s/^\Q$X_revs[0]\E\.0\.(\d+)$/$1/, @tmp_lbl; + @tmp_lbl = @rcs_rev_nums; + push @branch_nums, + grep (s/^\Q$X_revs[0]\E\.(\d+)\.\d+$/$1/, @tmp_lbl); + my $max = 0; + foreach my $num (@branch_nums) + { + $max = $num if $num > $max; + } + $max += 2; + $trunk_branches{$label_revision[$i]} = "$X_revs[0].0.$max"; + $label_revision[$i] = "$X_revs[0].0.$max"; + } + print "$label_revision[$i].\n"; + } + + $rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`; + print "Version label $new_label[$i] added to revision $label_revision[$i]\n"; + + if ($label_revision[$i] =~ /^(.*)\.0\./) + { + my $base = $1; + my $rootlbl = $new_label[$i]; + $rootlbl =~ s/.$/_broot$&/; + $rcs_output = `$rcs_base_command -n$rootlbl:$base \"$workfile\"`; + print "Version label $rootlbl added to revision $base\n"; + } + + } # foreach label + + if ($options{'cvs-module-path'}) + { + print "Moving $rcsarchive to $cvsarchive\n"; + move $rcsarchive, $cvsarchive or warn "Move failed: $!"; + } + + # hit_any_key; + } # foreach pvcs archive file + + # We processed a vcs directory, so if there were any files, lock it. + # We are guaranteed to have made the attempt at + # + # $skipdirlock gets set if a single file name was passed to this function to enable + # a '$0 *' operation... + if ( @pvcsarchives && !$skipdirlock) + { + my $fh = new IO::File ">>$donefile_name" or new IO::File ">$donefile_name"; + if ($fh) + { + $fh->close; + } + else + { + error_count 'error', \$errors, "couldn't create lockfile $cd/$donefile_name"; + } + } + + $curlevel = $curlevel - 1; + + chdir $old_dir + or die "Failed to restore original directory ($old_dir): ", $!, ", stopped"; + + # Update the relative directory path. + pop @rel_dirs if -d $dir; + + return ($errors, $warnings); + } + + + +# +# This function effectively does a cmp between two revision numbers +# It is intended to be passed into Perl's sort routine. +# +# the pvcs_out is not implemented well. It should probably be +# returnning $b[0] <=> $a[0] rather than $a[0] <=> $b[0] +# +# The @_ argument implementation was going to be used for revision +# comparison as an aid to remove the /^\sRev/ in revision comment +# error. The effort was fruitless at the time. +sub revisions + { + my @a = split /\./, (defined $a) ? $a : shift; + my @b = split /\./, (defined $b) ? $b : shift; + my $function = @_ ? shift : 'rcs_in'; + my ($i, $ret_val); + + die "Not enough arguments to revisions : a = ", join (".", @a), + "; b = ", join (".", @b), ", stopped" + unless (@a and @b); + + for ($i = 0; $i < scalar( @a ) && $i < scalar( @b ); $i++) + { + $a[$i] == $b[$i] or return ($a[$i] <=> $b[$i]); + } + + return 0 if (scalar (@a) == scalar (@b)); + + if ($function eq 'rcs_in') + { + return (($i == @b) || -1); + } + elsif ($function eq 'pvcs_out') + { + return (($i == @a) || -1); + } + else + { + die "error - Invalid function type passed to revisions ($function)", ", stopped"; + } + } + + + +sub pvcs_to_rcs_rev_number + { + my($input, $num_fields, @rev_string, $return_rev_num, $i); + + $input = $_[0]; + $num_fields = split /\./, $input; + @rev_string = @_; + # @rev_string[$num_fields-1] += 1; + + for( $i = 1; $i < $num_fields; $i += 1 ) + { + if ( $i % 2 ) + { + # DRP: 10/1 + # RCS does not allow revision zero + $rev_string[ $i ] += 1; + } + elsif ( $i ) + { + # DRP: 10/1 + # Branches must have even references for compatibility + # with CVS's magic branch numbers. + # (Indexes 2, 4, 6...) + $rev_string[ $i ] *= 2; + } + } + + # If this is a branch revision # (PVCS: a.b.c.*) then we want the CVS + # revision # instead. It's okay to do this conversion here since we + # never commit to branches. We'll only get a PVCS revision # in that + # form when looking through the revision labels. + if ($input =~ /\*$/) + { + pop @rev_string; + # If there is only one entry in @rev_string, this is a + # revision that needs to be attached to the trunk. Let it be + # for now. It might require a new branch, but we can't decide + # which branches are valid to create before we know what + # branches already exist. + push @rev_string, splice (@rev_string, -1, 1, "0") + unless @rev_string == 1; + } + + $return_rev_num = join ".", @rev_string; + return $return_rev_num; + } + + + + + +### +### +### +### +### +### MAIN program: checks to see if there are command line parameters +### +### +### +### +### + + + + + +# and read the options +die $usage + unless GetOptions (\%options, "h|help" => \&exit_help, + "recurse!", "mode|m=s", "errorfiles!", "l", + "rcs-dirs|rcs-directories|r=s", + "pvcs-dirs|pvcs-directories|p=s", "test-binaries|t!", + "rcs-extension=s", "verify|v=s", "vcsid|i=s", "verbose!", + "debug!", "force-binary!", "cvs-branch-labels!", + "warnings|w!", "cvs-module-path|d=s"); + + + +# +# Special processing for -l !^#%$^@#$%#$ +# +# At the moment, -l overrides --recurse, regardless of the order the +# options were passed in +# +$options{recurse} = 0 if defined $options{l}; +delete $options{l}; + + + +# Make sure we got acceptable values for rcs-dirs and pvcs-dirs +my @hits = grep /^$options{'rcs-dirs'}/i, ("leaf", "flat"); +@hits == 1 or die + "$0: $options{'rcs-dirs'} invalid argument to --rcs-dirs or ambiguous\n" + . " abbreviation.\n" + . " Must be one of: 'leaf' or 'flat'.\n" + . $usage; +$options{'rcs-dirs'} = $hits[0]; +$options{'rcs-dirs-flat'} = ($options{'rcs-dirs'} =~ /flat/); +delete $options{'rcs-dirs'}; + +@hits = grep /^$options{'pvcs-dirs'}/i, ("leaf", "flat"); +@hits == 1 or die + "$0: $options{'pvcs-dirs'} invalid argument to --pvcs-dirs or ambiguous\n" + . " abbreviation.\n" + . " Must be one of: 'leaf' or 'flat'.\n" + . $usage; +$options{'pvcs-dirs'} = $hits[0]; +$options{'pvcs-dirs-flat'} = ($options{'pvcs-dirs'} =~ /flat/); +delete $options{'pvcs-dirs'}; + +# and for verify +@hits = grep /^$options{verify}/i, ("none", "locks", "exists", "lockdates", "revs", "full"); +@hits == 1 or die + "$0: $options{verify} invalid argument to --verify or ambiguous\n" + . " abbreviation.\n" + . " Must be one of: 'none', 'locks', 'exists', 'lockdates', 'revs',\n" + . " or 'full'.\n" + . $usage; +$options{verify} = $hits[0]; +$options{verify} =~ /^none|locks|exists$/ or die + "$0: --verify=$options{verify} unimplemented.\n" + . $usage; + +# and mode +@hits = grep /^$options{mode}/i, ("convert", "verify"); +@hits == 1 or die + "$0: $options{mode} invalid argument to --mode or ambiguous abbreviation.\n" + . " Must be 'convert' or 'verify'.\n" + . $usage; +$options{mode} = $hits[0]; + +$options{'cvs-branch-labels'} or die + "$0: RCS Branch Labels unimplemented.\n" + . $usage; + +# export VCSID into th environment for ourselves and our children +$ENV{VCSID} = $options{vcsid}; + + + +# +# Verify we have all the binary executables we need to run this script +# +# Allowed this feature to be disabled in case which is missing or we are +# running on a system which does not return error codes properly (e.g. WIN95) +# +# -- i.e. I don't feel like grepping output yet. -- +# +my @missing_binaries = (); +if ($options{'test-binaries'}) + { + foreach (@bin_dependancies) + { + my $output = qx/which $_ 2>&1/; + print $output if $options{verbose} && $output; + if ($? || $output =~ /^no/) + { + push @missing_binaries, $_; + } + } + + if (scalar @missing_binaries) + { + print STDERR "The following executables were not found in your PATH: " + . join ( " ", @missing_binaries ) + . "\n" + . "You must correct this before continuing.\n"; + exit 1; + } + } +delete $options{'test-binaries'}; + + + +# +# set up our base archive manipulation commands +# + +# set up our rcs_command mods +$rcs_base_command = "rcs"; +$rcs_base_command .= " -x$options{'rcs-extension'}" + if $options{'rcs-extension'}; + +# set up our rcs_command mods +$ci_base_command = "ci"; +$ci_base_command .= " -x$options{'rcs-extension'}" + if $options{'rcs-extension'}; + + + +# +# So our logs fill in a manner we can monitor with 'tail -f' fairly easily: +# +STDERR->autoflush (1); +STDOUT->autoflush (1); + + + +# Initialize the globals we use to keep track of recursion +if ($options{recurse}) + { + $maxlevel = 10000; # Arbitrary recursion limit + } +else + { + $maxlevel = 1; + } +delete $options{recurse}; + +# So we can lock the directories behind us +$donefile_name = $options{'rcs-dirs-flat'} ? "" : "RCS/"; +$errorfile_name = $donefile_name . "#conv.errors"; +$donefile_name .= "#conv.done"; + + + +# +# start the whole thing and drop the return code on exit +# +push @ARGV, "." unless (@ARGV); +while ($_ = shift) + { + # reset the recursion level (corresponds to directory depth) + # level 0 is the first directory we enter... + $curlevel = -1; + my ($e, $w) = execdir($_); + $errors += $e; + $warnings += $w; + } + + + +print STDERR "$0: " . ($errors ? "Aborted" : "Done") . ".\n"; +print STDERR "$0: "; +print STDERR ($errors ? $errors : "No") . " error" . (($errors != 1) ? "s" : ""); +print STDERR ", " . ($warnings ? $warnings : "no") . " warning" . (($warnings != 1) ? "s" : "") + if ($options{warnings}); +print STDERR ".\n"; + + + +# +# Woo-hoo! We made it! +# +exit $errors; |