#!/usr/bin/perl -w

# PurePerl.pl  (or whatever you want to call it)
#
# This is intended for use on Windows machines to determine
# if a CPAN download is Pure Perl (tm) and therefore safe
# to install without a C compiler.
#
# Assuming you have downloaded the package in question 
# to your machine, just say:   perl PurePerl.pl
# and go from there

use Archive::Tar;
use Cwd;
use strict;

my $choice = 0;
my ($cwd, @menu_aoh, $filename);

# Clumsy but adequate "UI" for getting to the file in question
# we are done when a letter is entered rather than a number
while ($choice =~ /^\d+$/) {
   $cwd = getcwd();
   opendir(DIR, $cwd) or die "Can't open dir '$cwd'\n";

   # file is probably on desktop so include that w/ local dirs
   my @dir_entries = ('C:\WINDOWS\Desktop', readdir DIR);
   close DIR;
   @menu_aoh = ();

   # gather directories as numbered items
   my $i = 1;
   for (sort grep {-d} @dir_entries) {
      push @menu_aoh, {key => $i++, val => $_};
   }

   # gather *tar.gz files as lettered items
   $i = 'a';
   for (sort grep {/z$/} @dir_entries) {
      push @menu_aoh, {key => $i++, val => $_};
   }

   # now print out the navigation menu
   print "\n\nIn $cwd:\n";
   print "-------------\n";
   for (@menu_aoh) {
      print "-------------\n" if $_->{key} eq 'a';
      print "$_->{key}. $_->{val}\n";
   }
   print "\n\n----Choose a number or letter-> ";
   $choice = <>;

   # process the response
   chomp $choice;
   ($i) = grep {$menu_aoh[$_]{key} eq $choice} (0..$#menu_aoh);
   if ($choice =~ /^\d+/) {
      chdir $menu_aoh[$i]{val} or die "Can't chdir to $menu_aoh[$i]{va
+l}\n";
   } else {
      $filename = $menu_aoh[$i]{val};
   }
}

# At last, we can do what we came for...
my $file = "$cwd/$filename";
my $tar  = Archive::Tar->new($file, 1);

# 'list_files' also returns directories so skip them
my @file_list = grep { m|/[^/]+$| } $tar->list_files();

my %ext_list;
my $pure_perl_flag = 'DOES';
for my $fname (@file_list) {
   $fname =~ s{.*?([\w.]+)$}{$1};
   my ($ext) = ($fname =~ /\.([^.]+)$/);
   $ext = lc $ext;
   $ext ||= '<NONE>';
   $ext_list{$ext}++;
   $pure_perl_flag = 'does NOT' if $ext =~ /^(c|h)$/;
}

print "\nPURE PERL REPORT for $file\n\n";
print "Filename extensions found:\n";
for (sort keys %ext_list) {
   print "     $_ - ", $ext_list{$_}, "\n";
}
print "\nThis $pure_perl_flag appear to be a pure perl package\n";
[download]