From: Tom Christiansen <tchrist@mox.perl.com>
Subject: SRC: finding installed modules
Date: 22 May 1998 13:45:23 GMT

Ever want to find what modules are on your system, what versions they are,
and what they are supposed to do?    For example:

    FileHandle (2.00) - supply object methods for filehandles
    overload - Package for overloading perl operations
    Config - access Perl configuration information
    DynaLoader (1.03) - Dynamically load C libraries into Perl code
    Fcntl (1.03) - load the C Fcntl.h defines
    CGI::Imagemap (1.00) - imagemap behavior for CGI programs
    Net::Time (2.05) - time and daytime network client interface
    Net::FTP (2.33) - FTP Client class
    Net::Netrc (2.07) - OO interface to users netrc file
    Net::NNTP (2.17) - NNTP Client class
    Net::Domain (2.07) - Attempt to evaluate current hostname and domain

Here's a program to do that.  Make sure there's a dot at the end.

#!/usr/bin/perl
# pmdesc - tchrist@perl.com
# 

use strict;
use File::Find	qw(find);
use Getopt::Std	qw(getopts);
use Carp;

use vars (
    q!$opt_v!,		# give debug info
    q!$opt_w!,		# warn about missing descs on modules
    q!$opt_a!,		# include relative paths
    q!$opt_s!,		# sort output within each directory
);

$| = 1;

getopts('wvas') || die "bad usage";

@ARGV = @INC unless @ARGV;


# Globals.  wish I didn't really have to do this.
use vars (
    q!$Start_Dir!,	# The top directory find was called with
    q!%Future!,		# topdirs find will handle later
);

my $Module;

if ($opt_s) {
    if (open(ME, "-|")) {
	$/ = '';
	while (<ME>) {
	    chomp;
	    print join("\n", sort split /\n/), "\n";
	} 
	exit;
    } 
} 

MAIN: { 
    my %visited;
    my ($dev,$ino);

    @Future{@ARGV} = (1) x @ARGV;

    foreach $Start_Dir (@ARGV) { 
	delete $Future{$Start_Dir};

	print "\n<<Modules from $Start_Dir>>\n\n"
	    if $opt_v;

	next unless ($dev,$ino) = stat($Start_Dir);
	next if $visited{$dev,$ino}++;
	next unless $opt_a || $Start_Dir =~ m!^/!;

	find(\&wanted, $Start_Dir);
    } 
    exit;
}

sub modname { 
    local $_ = $File::Find::name;

    if (index($_, $Start_Dir . '/') == 0) {
	substr($_, 0, 1+length($Start_Dir)) = '';
    } 

    s { /              }	{::}gx;
    s { \.p(m|od)$     }	{}x;

    return $_;
}

sub wanted { 
    if ( $Future{$File::Find::name} ) { 
	warn "\t(Skipping $File::Find::name, qui venit in futuro.)\n"
	    if 0 and $opt_v;
	$File::Find::prune = 1;
	return;
    } 
    return unless /\.pm$/ && -f;
    $Module = &modname;

    my    $file = $_;

    unless (open(POD, "< $file")) {
	warn "\tcannot open $file: $!";
	    # if $opt_w;
	return 0;
    } 

    $: = " -:";

    local $/ = '';
    local $_;
    while (<POD>) {
	if (/=head\d\s+NAME/) {
	    chomp($_ = <POD>);
	    s/^.*?-\s+//s; 
	    s/\n/ /g;
	    #write;
	    my $v;
	    if (defined ($v = getversion($Module))) {
		print "$Module ($v) ";
	    } else {
		print "$Module ";
	    }
	    print "- $_\n";
	    return 1;
	} 
    } 

    warn "\t(MISSING DESC FOR $File::Find::name)\n" 
	if $opt_w;

    return 0;
} 

sub getversion {
    my $mod = shift;
    my $vers = `$^X -m$mod -e 'print \$${mod}::VERSION' 2>&1`;
    #my $vers = `$^X -m$mod -e 'print \$${mod}::VERSION' 2>/dev/null`;
    # 2> due to errors from MM_Unix etc
    $vers =~ s/^\s*(.*?)\s*$/$1/; # why is there whitespace here??
    return ($vers || undef);
}

sub getversion_internal {
    # This should really use system(), because otherwise we bloat.
    my $mod = shift;
    local $SIG{__WARN__} = sub {};
    eval "require $mod";
    if ($@) {
	warn "Cannot require $mod -- $@\n"
	    if $opt_v;
	return;
    } 
    my $vers;
    {
	no strict 'refs';
	return unless defined ($vers = ${ $mod . "::VERSION" });
    }
    $vers =~ s/^\s*(.*?)\s*$/$1/; # why is there whitespace here??
    return $vers;
} 


format  =
^<<<<<<<<<<<<<<<<<~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Module,	$_
.
-- 
    pos += screamnext[pos]  /* does this goof up anywhere? */
        --Larry Wall in util.c from the perl source code