view release on metacpan or  search on metacpan

bin/pmdesc  view on Meta::CPAN

#!/usr/bin/env perl
# pmdesc -- show NAME section

# ------ pragmas
use strict;
use warnings;
use FindBin qw($Bin);
use Getopt::Long;

our $VERSION = '2.1.0';

# ------ define variables
my $errors;     # error count
my $fullpath;   # full module path
my $module;     # module name
my $use_pod;    # use .pod instead of .pm file for systems with split POD/pm
my $vers;       # module version

BEGIN { $^W = 1 }

GetOptions ("splitpod"  => \$use_pod); 

$errors = 0;

MODULE: for $module (@ARGV) {
    if ($use_pod) {
        $fullpath = `$^X $Bin/podpath $module`;
    } else {
        $fullpath = `$^X $Bin/pmpath $module`;
    }
    if ($?) {
        $errors++;
        next;
    } 
    chomp $fullpath;
    unless (open(POD, "< $fullpath")) {
        warn "$0: cannot open $fullpath: $!";
        $errors++;
        next;
    } 

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

            next MODULE;
        } 
    } 
    print "no description found\n";
    $errors++;
} 

sub getversion {
    my $module = shift;

    my $vers;
    if ( $^O eq "MSWin32" ) {
        $vers = `$^X -S $Bin/pmvers $module 2>NUL`;
    } else {
        $vers = `$^X -S $Bin/pmvers $module 2>/dev/null`;
    }
    return if $?;
    chomp $vers;
    return $vers;
} 

exit ($errors != 0);

__END__

=head1 NAME

pmdesc - print out version and whatis description of perl modules

=head1 DESCRIPTION

Given one or more module names, show the version number (if known)
and the 'whatis' line, that is, the NAME section's description,
typically used for generation of whatis databases.

=head1 EXAMPLES

    $ pmdesc IO::Socket
    IO::Socket (1.25) - Object interface to socket communications

    $ oldperl pmdesc IO::Socket
    IO::Socket (1.1603) - Object interface to socket communications

    $ pmdesc `pminst -s | perl -lane 'print $F[1] if $F[0] =~ /site/'`
    XML::Parser::Expat (2.19) - Lowlevel access to James Clark's expat XML parser