#!/usr/bin/perl
=head1 NAME
lspm - list names and descriptions of Perl modules in a directory
=head1 SYNOPSIS
lspm -h
lspm [-p] [-a] [-c [num]] [-l len] [dir [dir dir ...]]
=head1 DESCRIPTION
Lists all or a subset of installed Perl modules, with version numbers
+and descriptions.
It will look in Perl's default search path for modules, C<@INC>, if yo
+u don't explicitly list any directories to walk. Note that this defau
+lt search excludes the current directory.
=head1 OPTIONS
=over 4
=item B<-h>, B<--help>
See a synopsis.
=item B<--man>
Browse the manpage.
=item B<-p>, B<--show-path>
Include path of found modules in output.
=item B<-a>, B<--align>
Vertically align descriptions.
=item B<-c>, B<--align-local>, B<--align-cont>
Align descriptions in blocks where the module names don't differ too m
+uch in length, to avoid pushing all descriptions way over to the righ
+t just because a few names are long. The output looks more ragged tha
+n with full alignment, but is still lined up locally and only require
+s the eye to cross small gaps between columns, so is usually more rea
+dable.
You can pass an optional positive integer argument to specify the leng
+th threshold; the default is 7.
=item B<-l>, B<--max-length>, B<--limit>
Cut off descriptions at specified length.
=back
=head1 SEE ALSO
L<http://www.cpan.org/modules/by-authors/id/TOMC/scripts/pmdesc.gz>
=head1 BUGS
I need something to write here.
=head1 COPYRIGHT AND LICENCE
Written by Aristotle Pagaltzis, (c)2006.
This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
=cut
use 5.6.1;
use strict;
use warnings;
use List::Util qw( min max );
use File::Find qw( find );
use File::Spec::Functions qw( rel2abs abs2rel no_upwards );
use ExtUtils::MakeMaker ();
use Getopt::Long 2.24, qw( :config bundling no_ignore_case no_auto_abb
+rev );
use Pod::Usage qw( pod2usage );
$|++;
sub module_name_from_filename {
local $_ = shift;
s! \.p(?:m|od) \z!!x;
s!/!::!g;
return $_;
}
sub get_module_description {
my ( $file, $max_length ) = @_;
my $desc;
open my $pod, "<", $file
or ( warn( "\tCannot open $file: $!" ), return );
my $get_line = sub {
$_ = <$pod>;
defined and s/\x0D?\x0A/\n/g; # fix DOS crud; see perlport
$_;
};
local $_;
# find description
while ( $get_line->() ) {
last if m{\A=head\d\s+NAME\b};
}
# skip leading junk
while ( $get_line->() ) {
last if /\A=\w/;
if( s{\A.*? - \s*}{} ) {
$desc .= $_;
last;
}
}
# collect description
while ( $get_line->() ) {
last if /\A=\w/;
s/\A\s+\z//;
$desc .= $_;
last if not length;
}
for( $desc ) {
last if not defined;
s/\s*\z//;
s/\s+/ /g;
$_ = substr $_, 0, $max_length if $max_length;
undef $_ if not length;
}
return $desc;
}
sub get_module_version {
my ( $file ) = @_;
local $_ = MM->parse_version( $file );
$_ = eval if $_ and /[^\d._]/;
return $_;
}
{
my %visited;
sub visited {
my ( $dir ) = @_;
my $unique_id;
if( $^O eq "MSWin32" ) {
$unique_id = $dir;
}
else {
my ( $dev, $inode ) = stat $dir or return;
$unique_id = join ':', $dev, $inode;
}
return ! ! $visited{ $unique_id }++;
}
}
sub name_width {
my ( $module, $version ) = @_;
length( $module . ( defined $version ? $version : '' ) );
}
sub print_module_info {
my ( $module, $version, $desc, $path, $name_width ) = @_;
my @output;
push @output, do {
local $_ = $version;
$_ = '' if not defined;
my $name = "$module ($_)";
$name = sprintf '%-*s', $name_width + 3, $name if defined( $de
+sc and $name_width );
$name;
};
push @output, "[$path]" if defined $path;
push @output, '-', $desc if defined $desc;
print "@output\n";
}
GetOptions(
'h|help' => sub { pod2usage( -verbose => 1 ) }
+,
'man' => sub { pod2usage( -verbose => 2 ) }
+,
'show-path|p!' => \( my $opt_path = '' ),
'align|a' => \( my $opt_align = 0 ),
'align-local|align-cont|c:7' => \( my $opt_cont ),
'max-length|limit|l' => \( my $opt_limit = 0 ),
) or pod2usage( -verbose => 1 );
pod2usage 'argument to --align-local must be a positive integer'
if $opt_cont and $opt_cont < 1;
@ARGV = no_upwards( @INC ) unless @ARGV;
my @info;
my $min_w = 100;
my $max_w = 0;
for my $inc_dir ( sort { length $b <=> length $a } map rel2abs( $_ ),
+@ARGV ) {
find(
{
wanted => sub {
return unless /\.p(?:m|od)\z/;
s/\.pod\z/.pm/; # if it's POD, parse the corresponding
+ code
return if not -f;
my @details = (
module_name_from_filename( abs2rel $File::Find::na
+me, $inc_dir ),
get_module_version( $_ ),
get_module_description( $_, $opt_limit ),
$opt_path ? $File::Find::name : undef,
);
if( $opt_cont ) {
my $cur_w = name_width @details;
$max_w = max $max_w, $cur_w;
$min_w = min $min_w, $cur_w;
if( $max_w - $min_w > $opt_cont ) {
print_module_info @$_, $max_w for @info;
@info = ();
$min_w = $max_w;
$max_w = 0;
}
}
if( $opt_align or $opt_cont ) {
push @info, \@details;
}
else {
print_module_info @details;
}
},
preprocess => sub { visited( $File::Find::dir ) ? () : @_
+},
},
$inc_dir,
);
}
if( @info ) {
my $name_width = max map name_width( @$_ ), @info;
print_module_info @$_, $name_width for @info;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.