Another stray file that got imported a long time ago and never cleaned up.
This commit is contained in:
Peter Wemm
parent
135d57d5e9
commit
c4c45a1dc3
@ -1,439 +0,0 @@
|
||||
#! /opt/bin/perl5
|
||||
#
|
||||
# Beware of the fact that this script was not written to handle
|
||||
# branches in the PVCS archives, but it might work nontheless. I have
|
||||
# a specific addition in this latest version that would not be
|
||||
# globally useful: automatically making Framemaker files binary with
|
||||
# -kb (regardless of the file extension).
|
||||
# ---------------------------------
|
||||
# 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:
|
||||
# The calling syntax is:
|
||||
# pvcs_to_rcs [-l]
|
||||
#
|
||||
# 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.
|
||||
#
|
||||
# NOTES:
|
||||
# * This script does not perform any error checking or logging of any kind
|
||||
# (i.e. USE AT YOUR OWN RISK)
|
||||
# * This script was developed using perl-5.003 on a Sun Solaris 2.5 machine
|
||||
# and executed from a csh
|
||||
# * PVCS archives in VCS/ or vcs/ subdirectories are left intact
|
||||
# * RCS archives are processed in the VCS/ or vcs/ subdirectories and
|
||||
# are moved (forcibly) up one level upon completion of the conversion
|
||||
# * This script has *not* been tested with PVCS archives with branches,
|
||||
# although the only thing I believe that might need to be changed
|
||||
# is the ORDER of revision processing (e.g. you can't checkin 1.2.4.1 if
|
||||
# you haven't yet checked in 1.2).
|
||||
# * 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
|
||||
# checkin 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).
|
||||
# * 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 workfile within the VCS/ or vcs/ will be deleted (or overwritten)
|
||||
# since it is used in the checkout of each revision
|
||||
# * 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
|
||||
#########################################################################
|
||||
|
||||
require("getcwd.pl");
|
||||
|
||||
#NOTE: Each possible binary extension is delimited by '.'
|
||||
$bin_ext =
|
||||
".bin.out.btl.rom.a07.lib.exe.tco.obj.t8u.c8u.o.lku.BIN.OUT.BTL.ROM.A07.LIB.EXE.TCO.OBJ
|
||||
.T8U.C8U.O.LKU.";
|
||||
|
||||
# the main procedure that is run once in each directory
|
||||
sub execdir
|
||||
{
|
||||
$curlevel= $curlevel +1;
|
||||
|
||||
#local sets the variables directory and prev directory local to the procedure
|
||||
|
||||
local($dir,$prevdir)=@_;
|
||||
|
||||
#change into the directory to be processed
|
||||
|
||||
chdir($dir);
|
||||
|
||||
#open the current directory for listing
|
||||
|
||||
opendir(CURDIR,".");
|
||||
|
||||
#initialize the list of filenames
|
||||
|
||||
local(@filenames);
|
||||
|
||||
#set filenames equal to directory listing
|
||||
|
||||
@filenames = readdir(CURDIR);
|
||||
|
||||
#clean up by closing the directory
|
||||
|
||||
closedir(CURDIR);
|
||||
|
||||
#initialize a list for any subdirectories
|
||||
local(@subdirs);
|
||||
|
||||
#begin a for loop to execute on each filename in the list @filename
|
||||
for (@filenames)
|
||||
|
||||
{
|
||||
#if the file is a directory...
|
||||
if (-d $_)
|
||||
{
|
||||
#include it in @subdir
|
||||
push(@subdirs,$_);
|
||||
}
|
||||
}
|
||||
|
||||
#for loop of subdirs
|
||||
for (@subdirs)
|
||||
#if not a parent directory, run execdir on each sub dir
|
||||
{
|
||||
if (($_ ne '.') and ($_ ne '..') and ($maxlevel > $curlevel))
|
||||
{
|
||||
&execdir($_,$dir);
|
||||
}
|
||||
}
|
||||
|
||||
#save the current directory
|
||||
$cd = &getcwd;
|
||||
|
||||
#Print output header for each directory
|
||||
print("Directory: $cd\n");
|
||||
|
||||
#determine the last directory in this path (to only process vcs or VCS)
|
||||
$_ = $cd;
|
||||
$num_dirs = split /\//;
|
||||
@dirs = @_;
|
||||
$last_dir = $dirs[$num_dirs-1];
|
||||
# print"Last directory is $last_dir\n";
|
||||
|
||||
#shell redirection: output from command in @ARGV is put in $output
|
||||
# $output = `@ARGV`;
|
||||
#begin a for loop to execute on each filename in the list @filename
|
||||
for (@filenames)
|
||||
{
|
||||
if ( (-f $_) and ($_ ne '.') and ($_ ne '..') and ($maxlevel > $curlevel)
|
||||
and ( ( $last_dir eq 'vcs' ) or ( $last_dir eq 'VCS' ) ) )
|
||||
{
|
||||
$got_archivefile = 0;
|
||||
$got_workfile = 0;
|
||||
$got_version_labels = 0;
|
||||
$got_description = 0;
|
||||
$got_rev_count = 0;
|
||||
|
||||
$file = $_;
|
||||
$abs_file = $cd . "/" . $file;
|
||||
print("Converting $abs_file...\n");
|
||||
$vlog_output = `vlog $_`;
|
||||
$_ = $vlog_output;
|
||||
# Split the cvs status output into individual lines
|
||||
@vlog_strings = split /\n/;
|
||||
$num_vlog_strings = @vlog_strings;
|
||||
$_ = $vlog_string[0];
|
||||
if ( /^vlog: warning/ )
|
||||
{
|
||||
print("$abs_file is NOT a valid PVCS archive!!!\n");
|
||||
}
|
||||
elsif( $vlog_output )
|
||||
{
|
||||
|
||||
# Collect all vlog output into appropriate variables
|
||||
|
||||
$num = 0;
|
||||
while( $num < $num_vlog_strings )
|
||||
{
|
||||
# print("$vlog_strings[$num]\n");
|
||||
|
||||
$_ = $vlog_strings[$num];
|
||||
|
||||
if( ( /^Workfile:\s*/ ) && (!$got_workfile ) )
|
||||
{
|
||||
$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 ];
|
||||
}
|
||||
# print"Workfile is $workfile\n";
|
||||
}
|
||||
|
||||
elsif( ( /^Archive:\s*/ ) && (!$got_archivefile ) )
|
||||
{
|
||||
$got_archivefile = 1;
|
||||
# get the string to the right of the above search (with any path stripped)
|
||||
$archivefile = $';
|
||||
$_=$archivefile;
|
||||
$num_fields = split /\//;
|
||||
if ( $num_fields > 1 )
|
||||
{
|
||||
$archivefile = $_[$num_fields - 1 ];
|
||||
}
|
||||
# print"Archive is $archivefile\n";
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
elsif ( ( /^Description:\s*/ ) && (!$got_description ) )
|
||||
{
|
||||
$got_description = 1;
|
||||
$description = "\"" . $vlog_strings[$num+1] . "\"";
|
||||
# print"Description is $description\n";
|
||||
$last_vl = $num - 1;
|
||||
}
|
||||
|
||||
elsif ( /^Rev\s*/ ) # get all the revision information at once
|
||||
{
|
||||
$rev_index = 0;
|
||||
while ( $rev_index < $rev_count )
|
||||
{
|
||||
$_=$vlog_strings[$num];
|
||||
/^Rev\s*/;
|
||||
$rev_num[$rev_index] = $';
|
||||
$_=$vlog_strings[$num+1];
|
||||
if ( /^Locked\s*/ )
|
||||
{
|
||||
$num += 1;
|
||||
}
|
||||
$_=$vlog_strings[$num+1];
|
||||
/^Checked in:\s*/;
|
||||
$checked_in[$rev_index] = "\"" . $' . "\"";
|
||||
$_=$vlog_strings[$num+3];
|
||||
/^Author id:\s*/;
|
||||
split;
|
||||
$author[$rev_index] = "\"" . $_[2] . "\"";
|
||||
$relative_comment_index = 0;
|
||||
$comment_string = "";
|
||||
while( ( $vlog_strings[$num+4+$relative_comment_index] ne
|
||||
"-----------------------------------" ) &&
|
||||
( $vlog_strings[$num+4+$relative_comment_index] ne
|
||||
"===================================" ) )
|
||||
{
|
||||
# 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
|
||||
$comment_string = $comment_string .
|
||||
$vlog_strings[$num+4+$relative_comment_index] . "\n";
|
||||
$relative_comment_index += 1;
|
||||
}
|
||||
# Convert any double quotes to an escaped double quote
|
||||
$comment_string =~ s/\"/\\\"/g;
|
||||
$comment[$rev_index] = "\"" . $comment_string . "\"";
|
||||
$num += ( 5 + $relative_comment_index );
|
||||
$rev_index += 1;
|
||||
}
|
||||
$num -= 1; #although there should be nothing left for this to matter
|
||||
}
|
||||
|
||||
$num += 1;
|
||||
|
||||
}
|
||||
|
||||
# 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];
|
||||
split /\"/;
|
||||
$label = @_[1];
|
||||
$_=@_[2];
|
||||
split;
|
||||
$label_revision[$label_index] = @_[1];
|
||||
|
||||
# Create RCS revision numbers corresponding to PVCS version numbers by
|
||||
# adding 1 to the revision number (# after last .)
|
||||
$rcs_rev = &pvcs_to_rcs_rev_number( $label_revision[$label_index]);
|
||||
$label_revision[ $label_index ] = $rcs_rev;
|
||||
# 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";
|
||||
}
|
||||
|
||||
# Create RCS revision numbers corresponding to PVCS version numbers by
|
||||
# adding 1 to the revision number (# after last .)
|
||||
|
||||
for( $i = 0; $i < $rev_count; $i += 1 )
|
||||
{
|
||||
$rcs_rev_num[ $i ] = &pvcs_to_rcs_rev_number( $rev_num[ $i ] );
|
||||
# print"PVCS is $rev_num[ $i ]; RCS is $rcs_rev_num[ $i ]\n"
|
||||
}
|
||||
|
||||
# Create RCS archive and check in all revisions, then label.
|
||||
# PVCS vlog lists revisions last-revision-first; reverse that ordering
|
||||
$first_time = 1;
|
||||
|
||||
for( $i = $rev_count - 1; $i >= 0; $i -= 1 )
|
||||
{
|
||||
print "get -r$rev_num[$i] $archivefile\\($workfile\\)\n";
|
||||
# $vcs_output = `vcs -u -r$rev_num[$i] $file`;
|
||||
$get_output = `get -r$rev_num[$i] $archivefile\\($workfile\\)`;
|
||||
if( $first_time )
|
||||
{
|
||||
$first_time = 0;
|
||||
$file_output = `file $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".
|
||||
if ( $comment[$i] eq "\"\"" )
|
||||
{
|
||||
$ci_command = "ci -f -r$rcs_rev_num[$i] -d$checked_in[$i] -w$author[$i]
|
||||
-t-$description -m\"no comment\" $workfile";
|
||||
}
|
||||
else
|
||||
{
|
||||
$ci_command = "ci -f -r$rcs_rev_num[$i] -d$checked_in[$i] -w$author[$i]
|
||||
-t-$description -m$comment[$i] $workfile";
|
||||
}
|
||||
print "$ci_command\n";
|
||||
$ci_output = `$ci_command`;
|
||||
|
||||
# Also check here whether this file ought to be "binary"
|
||||
$_=$file_output;
|
||||
split;
|
||||
if( $_[1] eq "Frame" )
|
||||
{
|
||||
print"Binary attribute -kb added (file type is Frame)\n";
|
||||
$rcs_output = `rcs -kb $workfile,v`;
|
||||
}
|
||||
else
|
||||
{
|
||||
$_=$workfile;
|
||||
$num_fields = split /\./;
|
||||
if ( $num_fields > 1 )
|
||||
{
|
||||
$ext = "." . $_[$num_fields - 1] . ".";
|
||||
if ( ( index $bin_ext, $ext ) > - 1 )
|
||||
{
|
||||
print"Binary attribute -kb added (file type is $ext)\n";
|
||||
$rcs_output = `rcs -kb $workfile,v`;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
$rcs_output = `rcs -l $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!)
|
||||
if ( $comment[$i] eq "\"\"" )
|
||||
{
|
||||
$ci_command = "ci -f -r$rcs_rev_num[$i] -d$checked_in[$i] -w$author[$i]
|
||||
-m\"no comment\" $workfile";
|
||||
}
|
||||
else
|
||||
{
|
||||
$ci_command = "ci -f -r$rcs_rev_num[$i] -d$checked_in[$i] -w$author[$i]
|
||||
-m$comment[$i] $workfile";
|
||||
}
|
||||
print "$ci_command\n";
|
||||
$ci_output = `$ci_command`;
|
||||
}
|
||||
}
|
||||
# Attach version labels
|
||||
for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 )
|
||||
{
|
||||
# print "rcs -n$new_label[$i]:$label_revision[$i] $workfile\n";
|
||||
$rcs_output = `rcs -n$new_label[$i]:$label_revision[$i] $workfile`;
|
||||
print "Version label $new_label[$i] added to revision $label_revision[$i]\n";
|
||||
}
|
||||
|
||||
# Move archive file up one directory level (above vcs/ or VCS/)
|
||||
$mv_output = `mv -f $workfile",v" ..`;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#print the output to STDOUT
|
||||
# print("$output");
|
||||
|
||||
$curlevel=$curlevel - 1;
|
||||
if ($dir ne $prevdir)
|
||||
{
|
||||
chdir('..');
|
||||
}
|
||||
}
|
||||
|
||||
sub pvcs_to_rcs_rev_number
|
||||
{
|
||||
local($input, $num_fields, @rev_string, $return_rev_num, $i);
|
||||
|
||||
$input = @_[0];
|
||||
$_ = $input;
|
||||
$num_fields = split /\./;
|
||||
@rev_string = @_;
|
||||
@rev_string[$num_fields-1] += 1;
|
||||
$return_rev_num = @rev_string[ 0 ];
|
||||
for( $i = 1; $i < $num_fields; $i += 1 )
|
||||
{
|
||||
$return_rev_num = $return_rev_num . "." . @rev_string[ $i ];
|
||||
}
|
||||
return $return_rev_num;
|
||||
}
|
||||
|
||||
##MAIN program: checks to see if there are command line parameters
|
||||
if ($#ARGV > 2) {
|
||||
|
||||
#if not then end and print help message
|
||||
die "Usage: pvcsns [-l]\n"};
|
||||
$curlevel=0-1;$maxlevel=10000;
|
||||
|
||||
if (@ARGV[0] eq "-l") {$maxlevel=1;shift @ARGV;}
|
||||
|
||||
#start the whole thing
|
||||
&execdir(".",".");
|
||||
|
||||
Loading…
Reference in New Issue
Block a user