لطفا منتظر باشید ...
 |  |
12.23. Program: Finding Versions and Descriptions of Installed Modules
Perl comes with
many modules included standard. Even more can be found on CPAN. The
following program prints out the names, versions, and descriptions of
all modules installed on your system. It uses standard modules like
File::Find and includes several techniques described in this chapter.To run it, type:% pmdesc
It prints a list of modules and their descriptions:FileHandle (2.00) - supply object methods for filehandles
IO::File (1.06021) - supply object methods for filehandles
IO::Select (1.10) - OO interface to the select system call
IO::Socket (1.1603) - Object interface to socket communications
...
With the -v flag,
pmdesc provides the names of the directories the
files are in:% pmdesc -v
<<<Modules from /usr/lib/perl5/i686-linux/5.00404>>>
FileHandle (2.00) - supply object methods for filehandles
...
The -w flag warns if a module
doesn't come with a pod description, and -s sorts the module list within each
directory.The program is given in Example 12-3.
Example 12-3. pmdesc
#!/usr/bin/perl -w
# pmdesc - describe pm files
# 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") or 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;
# install an output filter to sort my module list, if wanted.
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;
}
# calculate module name from file and directory
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 $_;
}
# decide if this is a module we want
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;
# skip obnoxious modules
if ($Module =~ /^CPAN(\Z|::)/) {
warn("$Module -- skipping because it misbehaves\n");
return;
}
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;
}
# run Perl to load the module and print its verson number, redirecting
# errors to /dev/null
sub getversion {
my $mod = shift;
my $vers = `$^X -m$mod -e 'print \$${mod}::VERSION' 2>/dev/null`;
$vers =~ s/^\s*(.*?)\s*$/$1/; # remove stray whitespace
return ($vers || undef);
}
format = ^<<<<<<<<<<<<<<<<<~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Module, $_
.
This can
also be accomplished through the backend programmer interface in the
CPANPLUS module, if you have it installed. This program displays
information on all available modules (the -X option is to silence any warnings about
invalid paths or version numbers):#!/usr/bin/perl -X
use CPANPLUS::Backend;
use Data::Dumper;
$cp = CPANPLUS::Backend->new;
$installed = $cp->installed->rv; # fetch list of installed mods
foreach my $module (sort keys %$installed) {
# get the module's information
$info = $cp->details(modules => [$module])->rv->{$module};
# display the fields we care about
printf("%-35.35s %44.44s\n", $module, $info->{Description});
}
When run, it outputs a table like this:Algorithm::Cluster Perl extension for the C clustering library
Algorithm::NaiveBayes None given
AnyDBM_File Uses first available *_File module above
Apache Interface to the Apache server API
Apache::AuthDBI None given
Apache::Connection Inteface to Apache conn_rec struct
|  | |
| 12.22. Example: Module Template |  | 13. Classes, Objects, and Ties |
Copyright © 2003 O'Reilly & Associates. All rights reserved.
