summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoderick Schertler <roderick@argon.org>1997-04-01 23:41:55 -0500
committerChip Salzenberg <chip@atlantic.net>1997-04-01 12:01:35 +1200
commitbbc6b0c70abf7d94d76d42e14766d95f09208cc9 (patch)
tree174674adc2d02ebb1a7a9a9cbc224246351ad43f
parentf83de2d26ec234569bb76fa4830dfac2a781bc03 (diff)
downloadperl-bbc6b0c70abf7d94d76d42e14766d95f09208cc9.tar.gz
Improve heuristics for pod2man titles
Subject: Re: Strange headers from perldoc On Mon, 31 Mar 1997 16:02:59 +0100, "M.J.T. Guy" <mjtg@cus.cam.ac.uk> said: > > When I go "perldoc CPAN" (in perl5.003_94 as it happens), the header > lines come out as > > ::home::mjtg::pUser Contr::home::mjtg::perl5.003_94::lib::CPAN(3) Here's a fix for that. It's just more heuristics, so it isn't perfect. In a related vein, this still leaves Getopt::Long(3pUser Contributed Perl DocumentatiGetopt::Long(3pm) in the page header on my system. "User Contributed Perl Documentation" is just too long. Would anybody mind replacing this with something shorter? Say Getopt::Long(3pm) User Perl Docs Getopt::Long(3pm) or Getopt::Long(3pm) Wankel Rotary Engine Getopt::Long(3pm) or even Getopt::Long(3pm) Getopt::Long(3pm) I'm partial the last of these, myself, but I'd be happy with anything less than about 20 characters. Patch happily supplied if nobody objects. p5p-msgid: pzn2ri9gto.fsf@eeyore.ibcinc.com
-rw-r--r--pod/pod2man.PL17
1 files changed, 16 insertions, 1 deletions
diff --git a/pod/pod2man.PL b/pod/pod2man.PL
index bd4dd418fd..cd14ce2866 100644
--- a/pod/pod2man.PL
+++ b/pod/pod2man.PL
@@ -404,7 +404,22 @@ if ($section =~ /^1/) {
$name = uc File::Basename::basename($name);
}
$name =~ s/\.(pod|p[lm])$//i;
-$name =~ s(/)(::)g; # translate Getopt/Long to Getopt::Long, etc.
+
+# Lose everything up to the first of
+# */lib/*perl* standard or site_perl module
+# */*perl*/lib from -D prefix=/opt/perl
+# */*perl*/ random module hierarchy
+# which works.
+$name =~ s-//+-/-g;
+if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
+ or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
+ or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
+ # Lose ^arch/version/.
+ $name =~ s-^[^/]+/\d+\.\d+/--;
+}
+
+# Translate Getopt/Long to Getopt::Long, etc.
+$name =~ s(/)(::)g;
if ($name ne 'something') {
FCHECK: {