[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Cvs-cvs] Changes to ccvs/contrib/pvcs2rcs.in [cvs1-11-x-branch]
|
From: |
Derek Robert Price |
|
Subject: |
[Cvs-cvs] Changes to ccvs/contrib/pvcs2rcs.in [cvs1-11-x-branch] |
|
Date: |
Thu, 01 Sep 2005 08:25:00 -0400 |
Index: ccvs/contrib/pvcs2rcs.in
diff -u /dev/null ccvs/contrib/pvcs2rcs.in:1.1.6.1
--- /dev/null Thu Sep 1 12:25:00 2005
+++ ccvs/contrib/pvcs2rcs.in Thu Sep 1 12:24:57 2005
@@ -0,0 +1,1150 @@
+#! @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.)
+# * 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 address@hidden
+#########################################################################
+
+
+
+#
+# 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)bin$' => "Binary",
+ '\.(?i)out$' => "Default Compiler Output",
+ '\.(?i)btl$' => "",
+ '\.(?i)rom$' => "",
+ '\.(?i)a07$' => "",
+ '\.(?i)lib$' => "DOS/Wintel/Netware Compiler Library",
+ '\.(?i)lif$' => "Netware Binary File",
+ '\.(?i)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)(bmp|gif|jpg|jpeg|jfif|tif|tiff|xbm)$' => "Image",
+ '\.(?i)dll$' => "DOS/Wintel Dynamically Linked Library",
+ '\.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::Path;
+use IO::File;
+use Getopt::Long;
+ $Getopt::Long::bundling = 1;
+# $Getopt::Long::ignorecase = 0;
+
+my $usage = "\
+usage: $0 -h
+ $0 [-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)
+
+ 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);
+
+# 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,
+ '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 ($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 @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);
+ }
+ 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";
+ my $vlog_output = `vlog $pvcsarchive`;
+ $_ = $vlog_output;
+
+ # Split the vcs status output into individual lines
+ my @vlog_strings = split /\n/;
+ 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 = $';
+ $_ = $workfile;
+ $num_fields = split /[\/\\]/;
+ 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*/;
+ split;
+ $author{$rev_num[$rev_index]} = "\"" .
$_[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)
+ && (
$vlog_strings[$num+4+$relative_comment_index]
+ !~
/^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/ ) )
+ {
+ # 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
+ foreach $revision (@rev_num)
+ {
+ $rcs_rev_num{ $revision } = &pvcs_to_rcs_rev_number(
$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});
+ split /\"/;
+ $label = $_[1];
+ print "Got label '$label'\n" if ($options{debug});
+ split /\s+/, $_[2];
+ $label_revision[$label_index] = $_[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
+ #
+ ##########
+ if ($options{verify} =~ /^locks|exists$/ and -f $rcsarchive)
+ {
+ print "Verified existence of $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`;
+ $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";
+ }
+ $first_time and $ci_command .= "
-t-$description";
+
+ $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;
+
+ $rcs_output = `$rcs_base_command -l$branch $workfile`
if (!$first_time);
+
+ # 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
+
+ # Attach version labels
+ for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 )
+ {
+ # print "rcs -x,v -n$new_label[$i]:$label_revision[$i]
$workfile\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";
+ } # foreach label
+
+ # 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";
+ 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];
+ $_ = $input;
+ $num_fields = split /\./;
+ @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;
+ push @rev_string, splice (@rev_string, -1, 1, "0");
+ }
+
+ $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!");
+
+
+
+#
+# Special processing for -l address@hidden
+#
+# 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");
address@hidden == 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'};
+
address@hidden = grep /^$options{'pvcs-dirs'}/i, ("leaf", "flat");
address@hidden == 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
address@hidden = grep /^$options{verify}/i, ("none", "locks", "exists",
"lockdates", "revs", "full");
address@hidden == 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
address@hidden = grep /^$options{mode}/i, ("convert", "verify");
address@hidden == 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)
+ {
+ if (system "which", $_)
+ {
+ 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;
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Cvs-cvs] Changes to ccvs/contrib/pvcs2rcs.in [cvs1-11-x-branch],
Derek Robert Price <=