Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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; }

In reply to lspm list names and descriptions of Perl modules in a directory by Aristotle

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (12)
    As of 2015-07-03 07:33 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (48 votes), past polls