Edit File: pvcs2rcs
#! /usr/bin/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 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)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 !^#%$^@#$%#$ # # 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) { 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;
Back to File Manager