Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: CPAN Purity tester

by idsfa (Vicar)
on Mar 13, 2006 at 16:10 UTC ( #536288=note: print w/ replies, xml ) Need Help??


in reply to CPAN Purity tester

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 Please vote on the code in the OP's node, not mine ...

#!/usr/bin/perl # The CPAN purity test. # Copyright 2006 by Joey Hess <joey@kitenet.net> # 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 arg +s\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 <DATA>; 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=<PROG>; } 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 (<IN>) { $lines++; } close IN; $lines=" "x(5-length($lines)).$lines; print "** $owner: [$lines lines] $file\n" if $ENV{CPAN_PURITY_VERB +OSE}; 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 lin +es in $myfiles files were not. EOF } 1

The intelligent reader will judge for himself. Without examining the facts fully and fairly, there is no way of knowing whether vox populi is really vox dei, or merely vox asinorum. — Cyrus H. Gordon


Comment on Re: CPAN Purity tester
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://536288]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (3)
As of 2014-07-26 10:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (175 votes), past polls