diff options
author | Roderick Schertler <roderick@argon.org> | 1997-04-01 23:41:55 -0500 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1997-04-01 12:01:35 +1200 |
commit | bbc6b0c70abf7d94d76d42e14766d95f09208cc9 (patch) | |
tree | 174674adc2d02ebb1a7a9a9cbc224246351ad43f | |
parent | f83de2d26ec234569bb76fa4830dfac2a781bc03 (diff) | |
download | perl-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.PL | 17 |
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: { |