| Category: | Utility Scripts |
| Author/Contact Info | /msg Aristotle |
| Description: | I recently looked at Tom Christiansen's scripts. One of them, called pmdesc, lists any or a subset of the modules you have installed, complete with the version number and a description. Handy! Unfortunately, it has several annoying traits. First of all, it's slow. Which one might live with, except it also picks up modules relative to wrong directories, so Foo::Bar might be reported, f.ex, as i686-linux::Foo::Bar. No problem, I thought, I'll just hack it. Unfortunately, the source is, well, less than tidy, with several unnecessary-to-be globals and badly distributed responsibilities. For so little code, it is suprisingly confusing to follow. So what's a hacker to do, eh? Here's a clean version. I fixed the directory problem by visiting the longest paths first, which ensures we see any subdirectories prior to their ancestors while traversing the trees. Speed was addressed by using an ExtUtils::MakeMaker utility function. While this imposes restrictions on the $VERSION assignments this script can cope with, CPAN uses the same function, so anything from CPAN is likely to comply anyway. Compared to the old code which had to actually compile each module, this is orders of magnitude faster. |
#!/usr/bin/perl -w
use strict;
use Carp;
use ExtUtils::MakeMaker;
use File::Find qw(find);
$|++;
sub get_module_name {
my ($path, $relative_to) = @_;
local $_ = $path;
s!\A\Q$relative_to\E/?!!;
s! \.p(?:m|od) \z!!x;
s!/!::!g;
return $_;
}
sub get_module_description {
my ($file) = @_;
open my $pod, "<", $file
or (warn("\tCannot open $file: $!"), return);
local $_;
local $/ = '';
while (<$pod>) {
if (/=head\d\s+NAME/) {
$_ = <$pod>;
return unless $_; # $_ may be undefined
chomp;
s/ \A .*? - \s+ //sx;
tr/\n/ /;
return $_;
}
}
return;
}
sub get_module_version {
local $_; # MM->parse_version is naughty
my $vers_code = MM->parse_version($File::Find::name) || '';
return eval $vers_code || undef;
}
my %visited;
if(@ARGV) {
if($ARGV[0] eq '-h') {
print while <DATA>;
exit;
}
shift if $ARGV[0] eq '--';
}
else {
@ARGV = @INC;
}
for my $inc_dir (sort { length $b <=> length $a } @ARGV) {
find({
wanted => sub {
return unless /\.p(?:m|od)\z/ && -f;
my $module = get_module_name($File::Find::name, $inc_dir)
+;
my $version = get_module_version($_);
my $desc = get_module_description($_);
$version = defined $version ? "($version)" : "";
$desc = defined $desc ? "- $desc" : "";
print join (" ", $module, grep $_, $version, $desc), "\n";
},
preprocess => sub {
my ($dev, $inode) = stat $File::Find::dir or return;
$visited{"$dev:$inode"}++ ? () : @_;
},
},
$inc_dir);
}
__DATA__
Usage: pmdesc2 [-h] [--] [dir [dir dir ...]]
Options: -h print this cruft
If no parameters given, searches @INC
|
|