node_6

#!/usr/bin/perl -w

# find_dup_pkgs.pl
# Look in a given directory for files with similar names which may indicate
# multiple versions of the same package. 
# "Similar" means that they begin with the pattern
#  <any non-zero number of characters excluding digits>-<digit>
# Source tarballs typically follow this naming scheme. For example:
#  lame-3.96.1.tar.gz     lame-3.97.tar.gz
# Here it would see that the both begin with 'lame' and would notify the user

# This script does NOT and should NEVER attempt to modify the filesystem
# itself. It is next to impossible to perfectly identify which packages
# (file names) are obsolete. The final decision should ALWAYS be left
# to the user. This is simply a tool to help them get started.

use strict;
use File::Basename;

my ($pkg_folder, @pkg_list, $pkg, @nomatch);

die "Where is the package folder?\n" if @ARGV < 1;
$pkg_folder = $ARGV[0];

die "'$pkg_folder' is not a directory\n" if ! -d $pkg_folder;
print "Package folder = $pkg_folder\n";

# Get a list of all files in the package directory. Keep only the file name
# and then sort the list alphabetically.
push @pkg_list, basename $_ for glob "$pkg_folder/*";
@pkg_list = sort @pkg_list;

while (@pkg_list)
{
	my $name;

	$pkg = shift @pkg_list;

	($name) = $pkg =~ /^(.+)-\d/;
	if ($name)
	{	# This package's file name matches our pattern. Check for siblings...
		my @similar;

# Doesn't catch  abc-1.2.3.tar.gz   abc-help-1.2.3.tar.gz
#		while (@pkg_list and index($pkg_list[0], $name) != -1)

		# Because the package list is in alphabetical order,
		# we can stop looking after the first non-match
		# Don't pull off (shift off) non-matches
		while (@pkg_list and $pkg_list[0] =~ /^\Q$name\E-\d/)
		{	# Found a match - save and keep looking
			push @similar, $pkg_list[0];
			shift @pkg_list;
		}

		if (@similar)
		{	# Display all similar files in a group... if there were any
			print "$pkg\n";
			print "$_\n" for @similar;
			print "\n";
		}
	} else
	{	# No match. Save miscreant package name and continue.
		push @nomatch, $pkg;
	}
}

# All done :)
print "These packages did not match my pattern:\n";
print "$_\n" for @nomatch;