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

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

our $VERSION = '2.0.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); 
print "use_pod = $use_pod\n";

$errors = 0;

MODULE: for $module (@ARGV) {
    if ($use_pod) {
        $fullpath = `$Bin/podpath $module`;
    } else {
        $fullpath = `$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 = `$^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 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
    XML::Parser (2.19) - A perl module for parsing XML documents

=head1 RESTRICTIONS

This only works on modules.  It should also work on filenames, but then
it's a bit tricky finding out the package to call the VERSION method on.

=head1 SEE ALSO

pmdesc(1)
pminst(1)
pmpath(1)
pmvers(1)

=head1 AUTHORS and COPYRIGHTS

Copyright (C) 1999 Tom Christiansen.

Copyright (C) 2006-2014 Mark Leighton Fisher.

=head1 LICENSE

This is free software; you can redistribute it and/or modify it
under the terms of either:
(a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
(b) the Perl "Artistic License".
(This is the Perl 5 licensing scheme.)

Please note this is a change from the
original pmtools-1.00 (still available on CPAN),
as pmtools-1.00 were licensed only under the
Perl "Artistic License".