Recipe 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


Perl Cookbook
Perl Cookbook, Second Edition
ISBN: 0596003137
EAN: 2147483647
Year: 2003
Pages: 501

flylib.com © 2008-2017.
If you may any questions please contact us: flylib@qtcs.net