[cvsnt] Pruning script for binary files (Perl)

Thu Nov 18 22:48:37 GMT 2004

> Anyway, here it is.

I know I've posted attachments in the past but the script didn't come
through this time.  Below is the code for anybody that wants to use or
review it.

--Aric

Aric Czarnowski
Unimax Systems Corporation
612-204-3634

#!perl.exe
#
####################### BEGIN POD
#############################################
#
use strict;
use warnings;

=pod

=head1 Description

Takes a file name via the C<--file> argument, does a C<cvs log> of that
file,
parses that output and then does a C<cvs admin -o> for each rev of that
file
which is not on a branch, which is not tagged and which is not the tip.

Originally implemented to remove intermediary binary revisions which
only
contribute to archive explosion and slow CVS response time.  It should
work
against any CVS file though.

=head1 Considerations

=over 4

=item *

It would be a good idea to backup the CVS archive's ,v file before
running
this to remove revisions just in case something goes wrong.

=item *

All branch revisions will remain from the branch point to that branch's
tip.
If your branches are long lived pruning could be less helpful than you
are
expecting.

=item *

This was orignally tested and used with a CVSNT 2.0.27 installations on
Win32.
There is no guarantee this will work with CVS or old CVSNT installations
(though it should).

=item *

UNIX installations have not been tested but should also work.  There are
no
Win32 specific shell commands used.

=back

=head1 Assumptions

=over 4

=item *

Intermediary revisions you are about to remove really are not needed.
If diffs
along the file's revision path could be useful in some way this is not
the
script for you.

=item *

You have a recent Perl installation with all core modules installed.
This was
originally developed against ActivePerl 5.6.1 but should work with any
core
Perl installation.

=item *

CVS is in your PATH.

=back

=head1 Input

The filename under CVS control you would like excess revisions removed
from.
See the command line help using C<-h> for more details on options.

=head1 Output

All processing output goes to STDOUT.

=head1 Version

 $Revision: 1.1 $
 $Date: 2004/11/18 21:02:38 $
 $Author: aczarnowski $

=cut

#
####################### BEGIN PARAMS
##########################################
# Usage
my $usage = qq[
perl $FindBin::Script [--debug] --file <file> [-h|--help] [--noremove]

--debug     Print extra debugging information
--file      File on which you want the CVS revision history trimmed
--help      This help screen
--noremove  Only show revisions that would be removed (do not perform
removal)

Also see the POD in this file using pod2text.
];

####################### BEGIN MAIN
############################################
use Cwd;
use Data::Dumper;
use FindBin;
use Getopt::Long;

# Read up command line options and validate them
my $debug = 0;
my $file = undef;
my $help = 0;
my $noRemove = 0;
GetOptions(	'h|help'   => \$help,
			'debug'    => \$debug,
			'file=s'   => \$file,
			'noremove' => \$noRemove,
           );
if($help) {
	die "$usage\n";
}
unless(defined($file) && -e $file) {
	die "ERROR: A valid file must be given via --file\n$usage";
}

# Processing really starts here
print "Starting $FindBin::Script (".localtime().")\n";
if($noRemove) {
	print "--noremove specified, revisions will not actually be
removed\n\n";
}

# Get directory stuff figured out and move next to the file if we need
too
my $startDir = cwd();
my ($fileName) = $file =~ m/.*[\\|\/](.*)/;
my ($fileDir) = $file =~ m/(.*)[\\|\/]/;
if(defined($fileDir) && $fileDir ne '') {
	chdir($fileDir) or die "ERROR: Cannot change to the file's
directory '$fileDir': $!\n";
	$fileDir = cwd();
}
else {
	$fileName = $file;
	$fileDir = $startDir;
}
if($debug) {
	print "\$file     = $file\n";
	print "\$startDir = $startDir\n";
	print "\$fileDir  = $fileDir\n";
	print "\$fileName = $fileName\n";
}

# Get log information
#
# @revs will hold all the revisions of the file.  %taggedRevs holds the
unique
# list of tagged revisions.  Since we only grab the first two revision
entries
# (i.e. 1.2 for 1.2.0.2) a file revision out on a branch will collapse
base to
# its branch point and that branch point will be associated with the
branch
# name ending up in %taggedRevs.  So branch points are tagged with the
branch
# name in %taggedRevs and are spared later.
#
print "Getting $file log information from CVS\n";

my $logCmd = "cvs log $fileName |";
if($debug) { print "$fileDir> $logCmd\n"; }
open(LOG, $logCmd) or die "ERROR: Cannot log $fileName\n";

my @revs = ();
my %taggedRevs = ();
while(<LOG>) {
	my $line = $_;

	if($line =~ /\t(\w*)\: (\d+\.\d+)/) {
		$taggedRevs{$2} .= $1;
	}
	elsif($line =~ /revision (\d+\.\d+)/) {
		push(@revs, $1);
	}
}
close(LOG);

# Figure out what the highest rev is so we don't blow away the HEAD
revision
$taggedRevs{$revs[0]} = 'TIP';
if($debug) {
	print "\@revs = ".Dumper(\@revs);
	print "\%taggedRevs = ". Dumper(\%taggedRevs);
}

# CVS out each rev that isn't interesting.  Note that the regular
expressions
# above only pull the first two parts of a branch tag so full branches
# should be preserved from their branch points on
#
if($noRemove) {
	print "Displaying revisions which would be pruned from
$fileName\n";
}
else {
	print "Pruning revisions from $fileName\n";
}
foreach my $rev (@revs) {
	unless(exists($taggedRevs{$rev})) {
		if($noRemove) {
			print "$rev\n";
		}
		else {
			my $cmd = "cvs admin -o $rev $fileName";
			print "$fileDir> $cmd\n";
			system($cmd);
		}
	}
}

# Confirm we are back where we started
unless($startDir eq $fileDir) {
	chdir($startDir) or warn "WARNING: Cannot return to '$startDir':
$!\n";
}

# Exit gracefully
print "Done with $FindBin::Script (".localtime().")\n";
exit(0);

####################### BEGIN SUBS
############################################