Does the extra "r" in "Prurity" stand for "Qruality"? :)

Since the author did not post the code, but just linked to an external server, this CUFP is kinda useless. I /msg'd him requesting that he do so, but got no reply, so I'm posting the code:

#!/usr/bin/perl
# The CPAN purity test.
# Copyright 2006 by Joey Hess 
# Licensed under the same terms as perl itself (GPL/Artistic).
use strict;
use warnings;
use Getopt::Long;

sub usage {
	die "usage: cpan-purity [--verbose] [--mine=regexp] -- program args\n";
}

GetOptions(
	"verbose" => \$ENV{CPAN_PURITY_VERBOSE},
	"mine=s" => \$ENV{CPAN_PURITY_MINE},
) && @ARGV || usage();

use File::Temp q{tempdir};
my $tempdir = tempdir(CLEANUP => 1);
if (! defined $tempdir) {
	die "failed to create temp directory, cannot run!";
}
if (exists $ENV{PERL5LIB}) {
	$ENV{PERL5LIB}.=":$tempdir";
}
else {
	$ENV{PERL5LIB}=$tempdir;
}
open (OUT, ">$tempdir/CPANPurity.pm") || 
	die "write $tempdir/CPANPurity.pm: $!";
print OUT ;
close OUT;

my $prog=shift;
if ($prog =~/perl/) {
	if ((! grep { $_ eq "-e" } @ARGV) || (grep { $_ =~ /^(-m|-M)$/ } @ARGV)) {
		die "Sorry, I your perl command line is too complex for me.\n";
		
	}
	$ENV{CPAN_PURITY_ONELINER}=1;
	$prog=shift;
}
else {
	if (! -x $prog) {
		foreach my $dir (split(":", $ENV{PATH})) {
			if (-x "$dir/$prog") {
				$prog="$dir/$prog";
				last;
			}
		}
	}
	die "Cannot find $prog in the PATH..\n" unless -x $prog;

	open (PROG, $prog) || die "can't read $prog: $!";
	my $code;
	{
		local $/=undef;
		$code=;
	}
	close PROG;
	if ($code=~/^#\s*!.*perl.*-T/) {
		print "Forcing $prog to run without taint checking..\n";
		$code=~s/(^#\s*!.*perl.*)-T/$1/;
		$prog="$tempdir/proggy";
		open(PROG, ">$prog") || die "write $prog: $!";
		print PROG $code;
		close PROG;
		chmod(0755, $prog) || die "chmod $prog: $!";
	}
}

if (! exists $ENV{CPAN_PURITY_TEST}) {
	$ENV{CPAN_PURITY_TEST}=1;
	system("perl", "-mCPANPurity", $prog, @ARGV);
}

__DATA__
# CPANPurity module
sub countfile {
	my $file=shift;
	my $owner=shift;
	
	my $lines=0;
	open (IN, "$file") || warn "can't read $file: $!";
	while () {
		$lines++;
	}
	close IN;
	$lines=" "x(5-length($lines)).$lines;
	print "** $owner: [$lines lines] $file\n" if $ENV{CPAN_PURITY_VERBOSE};
	return $lines;
}

END {
	my $skip=qr/CPANPurity\.pm/;
	my $mine=$skip;
	if (exists $ENV{CPAN_PURITY_MINE} &&
	    length $ENV{CPAN_PURITY_MINE}) {
		$ENV{CPAN_PURITY_MINE}=~s/::/\//g;
		$mine=qr/$ENV{CPAN_PURITY_MINE}/i;
	}
	
	my $liblines=0;
	my $mylines=0;
	my $libfiles=0;
	my $myfiles=0;
	foreach my $lib (keys %INC) {
		next if $lib=~/$skip/;
		if ($lib=~/$mine/) {
			$mylines+=countfile($INC{$lib}, "mine");
			$myfiles++;
		}
		else {
			$liblines+=countfile($INC{$lib}, "CPAN");
			$libfiles++;
		}
	}

	if (! $ENV{CPAN_PURITY_ONELINER}) {
		$mylines+=countfile($0, "mine");
		$myfiles++
	}
	else {
		$mylines++;
		print "** Looks like that was a perl one-liner..\n";
	}

	my $percent=0;
	if ($mylines > 0) {
		$percent=($liblines / ($mylines+$liblines)) * 100;
		$percent=~s/(\.\d\d).*/$1/;
	}

	print <<"EOF"
** CPAN Prurity test results: $percent% pure CPAN code.
** $liblines lines in $libfiles files were from CPAN, and $mylines lines in $myfiles files were not.
EOF
}

1