/usr/bin/pmdesc is in pmtools 2.0.0-1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | #!/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".
|