Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

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 <> # 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/") || die "write $tempdir/ $!"; 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

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://536288]
Jar. Jar!...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (7)
As of 2018-06-23 16:36 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (125 votes). Check out past polls.