#! /usr/sbin/perl
#
# NAME
#	proe_purge  -  discard antique version of Pro/E files
#
# USAGE
#	proe_purge [ -n nkeep ][ -d dir ][ -e file_extn ][ -p ][ -t ][ -help ]
#
# DESCRIPTION
#	Pro/E consumes non-trivial amounts of disc space.   Part of the cause
#	of this is that it keeps multiple versions of files, e.g. name.asm.7,
#	name.asm.8, name.asm.9, etc.
#
#	This program searches for sets of files in a directory tree that
#	match the pattern:
#
#		basename.extn.no
#
#	where "extn" can be any of "asm", "log", "txt" or "prt", and "no" can
#	be any positive decimal number {1, 2, 3, ... 10, 11, 12, ...}.
#
#	If the program finds a set of files that match the pattern, then it
#	will delete all but file with the highest extension number.   For
#	example, if the program finds, in a single directory, the files:
#
#		fred.asm.2
#		fred.asm.3
#		fred.asm.5
#
#	then it will delete files "fred.asm.2" and "fred.asm.3".
#
#	By default the program starts its search in the current directory.
#	If a different directory is specified via the "-d" command line
#	argument then the search starts in directory "dir".
#
#	By default, for each group of pattern-matched files, all but the one
#	with the highest number is deleted.   If a number "nkeep" is
#	specified with the "-n" command line argument then that number of
#	files is retained from each group.   For example, if "nkeep" is set
#	to "2" then only "fred.asm.2" would be deleted in the example above.
#
#	By default the "extn" part of a matching filename must be one of
#	"asm", "log", "txt" or "prt".  If a "file_extn" is specified with the
#	"-e" command line argument then only files with that extension are
#	matched.   The command line can hold multiple "-e" arguments.
#
#	If the "-p" command line option is given then the names of the
#	files deleted are printed to the standard output.
#
#	If the "-t" command line option is given then no files are actually
#	removed.   This can be used with the "-p" option to show the files
#	that would have been removed.
#
#	If the "-help" command line is given then a simple usage message
#	is printed to the standard output, and the program exits.
#
#	Symbolic links are ignored in the search for files to discard; only
#	plain directories holding plain files are considered.
#
# MODIFICATION HISTORY
#
#	ver	when	   who	what
#	===	====	   ===	====
#
#	1.1	4:sep:95   cjo	First submitted to sccs.
#
# SCCS IDENTIFIER
#	@(#)proe_purge	1.1 9/4/95
#

$progname = $0;		# How the user called this program.

@std_extns = ( "asm", "log", "prt", "txt", "trl", "drw", "inf", "she", "sym" );
@extns = ();

$nkeep = 1;		# Number of files to keep in each group.
$start_dir = ".";	# Base of directory tree to purge.
$print = 0;             # If set to 1 then print filenames to be deleted.
$test = 0;		# If set to 1 then don't delete files.


# Analyse the command line.

while( $#ARGV >= 0 ) {
	if( $ARGV[ 0 ] eq "-n" ) {
		if( $#ARGV <= 0 ) {
			print "$progname: \"-n\" takes following numeric argument\n";
			exit( 1 );
			}
		$nkeep = $ARGV[ 1 ];
		shift;
		}
	elsif( $ARGV[ 0 ] eq "-d" ) {
		if( $#ARGV <= 0 ) {
			print "$progname: \"-d\" takes following directory argument\n";
			exit( 1 );
			}
		$start_dir = $ARGV[ 1 ];
		shift;
		}
	elsif( $ARGV[ 0 ] eq "-e" ) {
		if( $#ARGV <= 0 ) {
			print "$progname: \"-e\" takes following filename extension argument\n";
			exit( 1 );
			}
		push( @extns, $ARGV[1 ] );
		shift;
		}
	elsif( $ARGV[ 0 ] eq "-p" ) {
		$print = 1;
		}
	elsif( $ARGV[ 0 ] eq "-t" ) {
		$test = 1;
		}
	elsif( $ARGV[ 0 ] eq "-help" ) {
		print "$progname [ -n nkeep ][ -d dir ][ -e file_extn ][ -p ][ -t ][ -help ]\n";
		exit( 0 );
		}
	else {
		print "$progname: unknown argument \"$ARGV[ 0 ]\"\n";
		exit( 1 );
		}
	shift;
	}


# Sanity checks on the user's typing skills.

if( $nkeep < 1 ) {
	print "$progname: number of files to keep (\"$nkeep\") must be greater than zero\n";
	exit( 1 );
	}

if(( ! -d $start_dir ) || ( ! -r $start_dir )) {
	print "$progname: directory \"$start_dir\" not readable\n";
	exit( 1 );
	}


# Use the standard set of filename extensions if the user hasn't specified any.

if( @extns == 0 ) {
	@extns = @std_extns;
	}


# print "nkeep = $nkeep\n";
# print "start_dir = $start_dir\n";
# print "extns = @extns\n";
# print "print = $print\n";
# print "test = $test\n";


# Process each directory in the tree.

chdir( $start_dir );
&process_dir( $start_dir );

exit( 0 );



#
# Process the contents of the current directory (named in $dir)
# and any subdirectories of it.
#

sub process_dir {
	local( $dir ) = @_;

	local( @filenames, @flist1, @flist2, @flist3, $base, $f, $ext, $ln );

	# Read all entries in the directory.
	if( opendir( DIR, "." ) == 0 ) {
		print "$progname: can't access directory \"$dir\"\n";
		return;
		}
	@filenames = readdir( DIR );
	closedir( DIR );


	# Derive list of plain files that may match our pattern.
	@flist1 = ();
	foreach $f ( @filenames ) {
		if( ! -f $f ) {				# Plain files only.
			next;
			}
		$ln = readlink( $f );			# Reject sym links.
		if( defined $ln ) {
			next;
			}
		if( ! ( $f =~ /^.+\..*\.[0-9]+$/ )) {	# Match "*.*.[0-9]*".
			next;
			}
		if( $f =~ /^.+\.0+$/ ) {		# Reject "file.0". 
			next;				# and "file.00", etc.
			}
		push( @flist1, $f );
		}

	# Match against the allowed extensions.
	@flist2 = ();
	foreach $f ( @flist1 ) {
		foreach $ext ( @extns ) {
			if( $f =~ /^.+\.$ext\.[0-9]+$/ ) { # Match "*.extn.[0-9]*".
				push( @flist2, $f );
				}
			}
		}

	# Sort the files alphabetically.
	@flist2 = sort( @flist2 );

	# Derive groups of matching filenames.
	$base = "";
	@flist3 = ();
	foreach $f ( @flist2 ) {
		if( $base eq "" ) {
			$base = $f;
			$base =~ s/[0-9]+$//;
			push( @flist3, $f );
			}
		elsif( $f =~ /$base[0-9]+$/ ) {
			push( @flist3, $f );
			}
		else {
			&process_file_group( @flist3 );

			@flist3 = ();
			$base = "";

			$base = $f;
			$base =~ s/[0-9]+$//;
			push( @flist3, $f );
			}
		}

	if( @flist3 != 0 ) {
		&process_file_group( @flist3 );
		}


	# Finally, process any subdirectories of this directory.
	foreach $f ( @filenames ) {
		if( ! -d $f ) {				# Directories only.
			next;
			}
		$ln = readlink( $f );			# Reject sym links.
		if( defined $ln ) {
			next;
			}
		if(( $f eq "." ) || ( $f eq ".." )) {	# Reject "." and "..".
			next;
			}

		chdir( $f );
		&process_dir( "$dir/$f" );
		chdir( ".." );
		}
	}


#
# Discard excess files from the group of matched filenames @files.
#

sub process_file_group {
	local( @files ) = @_;

	local( $base, $ver, $f, @vers );

	# Give up if list of files is empty.
	if( @files == 0 ) {
		return;
		}

	# Give up if list of files has $nkeep elements or fewer.
	if( @files <= $nkeep ) {
		return;
		}

	# Get "fred.txt." from "fred.txt.3".
	$base = $files[ 0 ];
	$base =~ s/[0-9]+$//;

	# Derive list of version numbers.
	@vers = ();
	foreach $f ( @files ) {
		$ver = $f;
		$ver =~ s/$base//;
		push( @vers, $ver );
		}

	# Sort the version numbers list numerically.
	@vers = sort( numerically @vers );

	# Discard files until $nkeep remain.
	while( @vers > $nkeep ) {
		$ver = shift( @vers );
		$f = "$base"."$ver";

		if( $print == 1 ) {
			print "$dir/$f\n";
			}
		if( $test == 0 ) {
			unlink( $f );
			}
		}
	}


sub numerically { $a <=> $b; }