#!perl
use File::Find;
use strict;
use warnings;
use Sys::Hostname;
use POSIX;
use vars qw/$inc $module $filename $version $host $date @files %dupe $
+joininc $ji $title/;
use constant DEBUG=>0;
use Cwd;

select STDOUT;
$|++;

$host=hostname();
$date=POSIX::strftime("%Y-%m-%d",localtime());
my ($mw,$vw,$fw)=(40,10,0);

warn "Searching for all .pm's in the following directories: \n\t".join
+("\n\t",@INC)."\n";

my @inc=sort {length $b <=> length $b} map { $_ eq '.' ? cwd() : $_ } 
+@INC;

$joininc=$ji=join(", ",map { "'$_'" } @inc);

my $start=time;
find {no_chdir=>1,
      wanted=>sub {
                   findver($_) if /\.pm$/i && -f;
                  }
     }, @INC;
my $finish=time;
warn "Found @{[scalar @files]} modules in @{[$finish-$start]} seconds.
+\n";


sub findver {
    my $file=shift;
    return if $dupe{$file}++ or /[\\\/]blib[\\\/]/;
    open my $fh,$file or die "Cant read $file :$!";
    my $ver;
    while (<$fh>) {
        # Following regex is From ExtUtils::MakeMaker;
        if (/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
            our $VERSION;
            $ver=eval($_);
            warn "Failed to eval version string\n$_\nin '$file' becaus
+e $@"
                if ($@);
            last;
        }
    }
    $ver="Unknown" if not defined $ver;
    my $mod=$file;
    foreach my $inc (@inc) {
        if ($mod=~s/^\Q$inc\E//i) {
            $mod=~s/[\\\/]/::/g;
            $mod=~s/^(-thread)?::|\.pm$//ig;
            last;
        }
    }
    ${$_->[0]} < length($_->[1]) and (${$_->[0]}=length($_->[1]))
        for ([\$mw,$mod],[\$vw,$ver],[\$fw,$file]);
    push @files,[$mod,$ver,$file];

}
$_+=2 for $mw,$vw,$fw;

my $widest=($mw+$vw+$fw+8);
$title='*** Installed Perl Modules Version Report ***';
my $eval_str='
format STDOUT_TOP =
@'.('<' x $widest).'
$title
     Host : @<<<<<<<<<<<<<<<<<<
$host
     Date : @<<<<<<<<<<<<<<<<<<
$date
     Paths: ^'.('<' x ($widest-14)).'
$joininc
~~            ^'.('<' x ($widest-14)).'
$joininc

  Module'.(" " x($mw-6)).'  Version'.(" "x($vw-7))."  Filename\n".("-"
+ x $widest)."\n.\n\n";
$eval_str.='
format STDOUT =
| @'.("<" x ($mw-1) ).'| @'.("<" x ($vw-1))."| @".("<" x ($fw-1))." |\
+n".'$module,$version,$filename'."\n.\n\n";

print $eval_str if DEBUG;
eval $eval_str;
die $@ if $@;

foreach my $file (sort {$a->[0] cmp $b->[0]} @files) {
    ($module,$version,$filename)=@$file;
    write;
    $joininc=$ji;
}
[download]