use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries. Thus you write
# $startperl
+# $man3ext
# to ensure Configure will look for $Config{startperl}.
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
-chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//;
-$file =~ s/\.pl$//
- if ($Config{'osname'} eq 'VMS' or
- $Config{'osname'} eq 'OS2'); # "case-forgiving"
+$origdir = cwd;
+chdir dirname($0);
+$file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# You can use $Config{...} to use Configure variables.
print OUT <<"!GROK!THIS!";
-$Config{'startperl'}
+$Config{startperl}
+ eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
+ if \$running_under_some_shell;
+
+\$DEF_PM_SECTION = '$Config{man3ext}' || '3';
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
-eval 'exec perl -S $0 "$@"'
- if 0;
=head1 NAME
[ B<--date=>I<string> ]
[ B<--fixed=>I<font> ]
[ B<--official> ]
+[ B<--lax> ]
I<inputfile>
=head1 DESCRIPTION
F</usr/local/perl/man/>. By default, section 1 will be used
unless the file ends in F<.pm> in which case section 3 will be selected.
+=item lax
+
+Don't complain when required sections aren't present.
+
=back
=head1 Anatomy of a Proper Man Page
=item HISTORY
Programs derived from other sources sometimes have this, or
-you might keep a modification long here.
+you might keep a modification log here.
=back
(F) The input file wasn't available for the given reason.
-=item high bit char in input stream
-
-(W) You can't use high-bit characters in the input stream,
-because the translator uses them for its own nefarious purposes.
-Use an HTML entity in angle brackets instead.
-
=item Improper man page - no dash in NAME header in paragraph %d of %s
(W) The NAME header did not have an isolated dash in it. This is
=item Unknown escape: %s in %s
(W) An unknown HTML entity (probably for an 8-bit character) was given via
-a C<E<lt>E<gt>> directive. Besides amp, lt, gt, and quot, recognized
+a C<EE<lt>E<gt>> directive. Besides amp, lt, gt, and quot, recognized
entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
If you would like to print out a lot of man page continuously, you
probably want to set the C and D registers to set contiguous page
-numbering and even/odd paging, at least one some versions of man(7).
+numbering and even/odd paging, at least on some versions of man(7).
Settting the F register will get you some additional experimental
indexing:
=head1 RESTRICTIONS
-You shouldn't use 8-bit characters in the input stream, as these
-will be used by the translator.
+None at this time.
=head1 BUGS
$/ = "";
$cutting = 1;
-
-($version,$patch) = `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3}(?: +)(?:\S+)?)(?:.*patchlevel (\d\S*))?/s;
+@Indices = ();
+
+# We try first to get the version number from a local binary, in case we're
+# running an installed version of Perl to produce documentation from an
+# uninstalled newer version's pod files.
+if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
+ my $perl = (-x './perl' && -f './perl' ) ?
+ './perl' :
+ ((-x '../perl' && -f '../perl') ?
+ '../perl' :
+ '');
+ ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl;
+}
+# No luck; we'll just go with the running Perl's version
+($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
$DEF_RELEASE = "perl $version";
$DEF_RELEASE .= ", patch $patch" if $patch;
my $secs = shift;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
+ $year += 1900;
return "$mday/$mname/$year";
}
$DEF_CENTER = "User Contributed Perl Documentation";
$STD_CENTER = "Perl Programmers Reference Guide";
$DEF_FIXED = 'CW';
+$DEF_LAX = 0;
sub usage {
warn "$0: @_\n" if @_;
--date=string (default "$DEF_DATE")
--fixed=font (default "$DEF_FIXED")
--official (default NOT)
+ --lax (default NOT)
EOF
}
date=s
fixed=s
official
+ lax
help));
$DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
usage() if $opt_help;
usage("Need one and only one podpage argument") unless @ARGV == 1;
-$section = $opt_section || ($ARGV[0] =~ /\.pm$/ ? 3 : $DEF_SECTION);
+$section = $opt_section || ($ARGV[0] =~ /\.pm$/
+ ? $DEF_PM_SECTION : $DEF_SECTION);
$RP = $opt_release || $DEF_RELEASE;
$center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
+$lax = $opt_lax || $DEF_LAX;
$CFont = $opt_fixed || $DEF_FIXED;
die "roff font should be 1 or 2 chars, not `$CFont_embed'";
}
-$section = $opt_section || $DEF_SECTION;
$date = $opt_date || $DEF_DATE;
for (qw{NAME DESCRIPTION}) {
$name = @ARGV ? $ARGV[0] : "<STDIN>";
$Filename = $name;
-$name = uc($name) if $section =~ /^1/;
-$name =~ s/\..*//;
+if ($section =~ /^1/) {
+ require File::Basename;
+ $name = uc File::Basename::basename($name);
+}
+$name =~ s/\.(pod|p[lm])$//i;
+
+# 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 ^site(_perl)?/.
+ $name =~ s-^site(_perl)?/--;
+ # Lose ^arch/. (XXX should we use Config? Just for archname?)
+ $name =~ s~^(.*-$^O|$^O-.*)/~~o;
+ # Lose ^version/.
+ $name =~ s-^\d+\.\d+/--;
+}
+
+# Translate Getopt/Long to Getopt::Long, etc.
+$name =~ s(/)(::)g;
if ($name ne 'something') {
FCHECK: {
open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
while (<F>) {
+ next unless /^=\b/;
if (/^=head1\s+NAME\s*$/) { # an /m would forgive mistakes
$_ = <F>;
unless (/\s*-+\s+/) {
$oops++;
- warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]:\n"
+ warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
+ } else {
+ my @n = split /\s+-+\s+/;
+ if (@n != 2) {
+ $oops++;
+ warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n"
+ }
+ else {
+ %namedesc = @n;
+ }
}
- %namedesc = split /\s+-\s+/;
last FCHECK;
}
+ next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME
+ next if /^=pod\b/; # It is OK to have =pod before NAME
+ die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax;
}
- die "$0: Invalid man page - no NAME line in $ARGV[0]\n";
+ die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax;
}
close F;
}
.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
.ds L" ""
.ds R" ""
+''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of
+''' \\*(L" and \\*(R", except that they are used on ".xx" lines,
+''' such as .IP and .SH, which do another additional levels of
+''' double-quote interpretation
+.ds M" """
+.ds S" """
+.ds N" """""
+.ds T" """""
.ds L' '
.ds R' '
+.ds M' '
+.ds S' '
+.ds N' '
+.ds T' '
'br\\}
.el\\{\\
.ds -- \\(em\\|
.tr \\*(Tr
.ds L" ``
.ds R" ''
+.ds M" ``
+.ds S" ''
+.ds N" ``
+.ds T" ''
.ds L' `
.ds R' '
+.ds M' `
+.ds S' '
+.ds N' `
+.ds T' '
.ds PI \\(*p
'br\\}
END
END
print <<"END";
-.TH $name $section "$RP" "$date" "$center"
-.IX Title "$name $section"
+.TH $name $section "$date" "$RP" "$center"
.UC
END
+push(@Indices, qq{.IX Title "$name $section"});
+
while (($name, $desc) = each %namedesc) {
for ($name, $desc) { s/^\s+//; s/\s+$//; }
- print qq(.IX Name "$name - $desc"\n);
+ push(@Indices, qq(.IX Name "$name - $desc"\n));
}
print <<'END';
..
.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
. \" AM - accent mark definitions
-.bd S B 3
+.bd B 3
. \" fudge factors for nroff and troff
.if n \{\
. ds #H 0
$indent = 0;
+$begun = "";
+
+# Unrolling [^-=A-Z>]|[A-Z](?!<)|[-=](?![A-Z]<)[\x00-\xFF] gives: // MRE pp 165.
+my $nonest = q{(?x) # Turn on /x mode.
+ (?: # Group
+ [^-=A-Z>]* # Anything that isn't a dash, equal sign or
+ # closing hook isn't special. Eat as much as
+ # we can.
+ (?: # Group.
+ (?: # Group.
+ [-=] # We want to recognize -> and =>.
+ (?![A-Z]<) # So, as long as it isn't followed by markup
+ [\x00-\xFF] # anything may follow - and =
+ |
+ [A-Z] # Capitals are fine too,
+ (?!<) # But not if they start markup.
+ ) # End of special sequences.
+ [^-=A-Z>]* # Followed by zero or more non-special chars.
+ )* # And we can repeat this as often as we can.
+ )}; # That's all folks.
+
while (<>) {
if ($cutting) {
next unless /^=/;
$cutting = 0;
}
+ if ($begun) {
+ if (/^=end\s+$begun/) {
+ $begun = "";
+ }
+ elsif ($begun =~ /^(roff|man)$/) {
+ print STDOUT $_;
+ }
+ next;
+ }
chomp;
# Translate verbatim paragraph
$verbatim = 0;
+ if (/^=for\s+(\S+)\s*/s) {
+ if ($1 eq "man" or $1 eq "roff") {
+ print STDOUT $',"\n\n";
+ } else {
+ # ignore unknown for
+ }
+ next;
+ }
+ elsif (/^=begin\s+(\S+)\s*/s) {
+ $begun = $1;
+ if ($1 eq "man" or $1 eq "roff") {
+ print STDOUT $'."\n\n";
+ }
+ next;
+ }
+
# check for things that'll hosed our noremap scheme; affects $_
init_noremap();
# trofficate backslashes; must do it before what happens below
s/\\/noremap('\\e')/ge;
+ # protect leading periods and quotes against *roff
+ # mistaking them for directives
+ s/^(?:[A-Z]<)?[.']/\\&$&/gm;
+
# first hide the escapes in case we need to
# intuit something and get it wrong due to fmting
- s/([A-Z]<[^<>]*>)/noremap($1)/ge;
+ 1 while s/([A-Z]<$nonest>)/noremap($1)/ge;
# func() is a reference to a perl function
s{
)
} {I<$1>}gx;
- # func(n) is a reference to a man page
+ # func(n) is a reference to a perl function or a man page
s{
- (\w+)
+ ([:\w]+)
(
- \(
- [^\s,\051]+
- \)
+ \( [^\051]+ \)
)
} {I<$1>\\|$2}gx;
# convert simple variable references
- s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
+ s/(\s+)([\$\@%&*][\w:]+)(?!\()/${1}C<$2>/g;
if (m{ (
[\-\w]+
while ($maxnest-- && /[A-Z]</) {
# can't do C font here
- s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
+ s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg;
# files and filelike refs in italics
- s/F<([^<>]*)>/I<$1>/g;
+ s/F<($nonest)>/I<$1>/g;
# no break -- usually we want C<> for this
- s/S<([^<>]*)>/nobreak($1)/eg;
+ s/S<($nonest)>/nobreak($1)/eg;
+
+ # LREF: a la HREF L<show this text|man/section>
+ s:L<([^|>]+)\|[^>]+>:$1:g;
# LREF: a manpage(3f)
s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
? "the section on I<$2> in the I<$1> manpage"
: "the section on I<$2>"
}
- }gex;
+ }gesx; # s in case it goes over multiple lines, so . matches \n
s/Z<>/\\&/g;
# comes last because not subject to reprocessing
- s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
+ s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg;
}
if (s/^=//) {
($Cmd, $_) = split(' ', $_, 2);
+ $dotlevel = 1;
+ if ($Cmd eq 'head1') {
+ $dotlevel = 1;
+ }
+ elsif ($Cmd eq 'head2') {
+ $dotlevel = 1;
+ }
+ elsif ($Cmd eq 'item') {
+ $dotlevel = 2;
+ }
+
if (defined $_) {
- &escapes;
+ &escapes($dotlevel);
s/"/""/g;
}
s/\s+$//;
delete $wanna_see{$_} if exists $wanna_see{$_};
print qq{.SH "$_"\n};
- print qq{.IX Header "$_"\n};
+ push(@Indices, qq{.IX Header "$_"\n});
}
elsif ($Cmd eq 'head2') {
print qq{.Sh "$_"\n};
- print qq{.IX Subsection "$_"\n};
+ push(@Indices, qq{.IX Subsection "$_"\n});
}
elsif ($Cmd eq 'over') {
push(@indent,$indent);
}
elsif ($Cmd eq 'back') {
$indent = pop(@indent);
- warn "Unmatched =back\n" unless defined $indent;
+ warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
$needspace = 1;
}
elsif ($Cmd eq 'item') {
s/^\*( |$)/\\(bu$1/g;
+ # if you know how to get ":s please do
+ s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
+ s/\\\*\(L"([^"]+?)""/'$1'/g;
+ s/[^"]""([^"]+?)""[^"]/'$1'/g;
+ # here do something about the $" in perlvar?
print STDOUT qq{.Ip "$_" $indent\n};
- print qq{.IX Item "$_"\n};
+ push(@Indices, qq{.IX Item "$_"\n});
}
elsif ($Cmd eq 'pod') {
# this is just a comment
}
else {
- warn "Unrecognized pod directive: $Cmd\n";
+ warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
}
}
else {
if ($needspace) {
&makespace;
}
- &escapes;
+ &escapes(0);
clear_noremap(1);
print $_, "\n";
$needspace = 1;
.rn }` ''
END
-if (%wanna_see) {
+if (%wanna_see && !$lax) {
@missing = keys %wanna_see;
warn "$0: $Filename is missing required section"
. (@missing > 1 && "s")
$oops++;
}
+foreach (@Indices) { print "$_\n"; }
+
exit;
#exit ($oops != 0);
}
sub escapes {
+ my $indot = shift;
s/X<(.*?)>/mkindex($1)/ge;
s/([^"])--"/$1\\*(--"/g;
# fix up quotes; this is somewhat tricky
+ my $dotmacroL = 'L';
+ my $dotmacroR = 'R';
+ if ( $indot == 1 ) {
+ $dotmacroL = 'M';
+ $dotmacroR = 'S';
+ }
+ elsif ( $indot >= 2 ) {
+ $dotmacroL = 'N';
+ $dotmacroR = 'T';
+ }
if (!/""/) {
- s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
- s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
+ s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge;
+ s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge;
}
#s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
# make troff just be normal, but make small nroff get quoted
# decided to just put the quotes in the text; sigh;
sub ccvt {
- local($_,$prev) = @_;
- if ( /^\W+$/ && !/^\$./ ) {
- ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
- # what about $" ?
- } else {
- noremap(qq{${CFont_embed}$_\\fR});
- }
+ local($_,$prev) = @_;
noremap(qq{.CQ "$_" \n\\&});
}
sub mkindex {
my ($entry) = @_;
my @entries = split m:\s*/\s*:, $entry;
- print ".IX Xref ";
- for $entry (@entries) {
- print qq("$entry" );
- }
- print "\n";
+ push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries;
return '';
}
}
sub init_noremap {
- if ( /[\200-\377]/ ) {
- warn "high bit char in input stream";
- }
+ # escape high bit characters in input stream
+ s/([\200-\377])/"E<".ord($1).">"/ge;
}
sub clear_noremap {
# otherwise the interative \w<> processing would have
# been hosed by the E<gt>
s {
- E<
- ( [A-Za-z]+ )
+ E<
+ (
+ ( \d + )
+ | ( [A-Za-z]+ )
+ )
>
} {
- do {
- exists $HTML_Escapes{$1}
- ? do { $HTML_Escapes{$1} }
+ do {
+ defined $2
+ ? chr($2)
+ :
+ exists $HTML_Escapes{$3}
+ ? do { $HTML_Escapes{$3} }
: do {
- warn "Unknown escape: $& in $_";
+ warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
"E<$1>";
}
}
sub internal_lrefs {
local($_) = shift;
+ local $trailing_and = s/and\s+$// ? "and " : "";
s{L</([^>]+)>}{$1}g;
my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
$retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
. " elsewhere in this document";
+ # terminal space to avoid words running together (pattern used
+ # strips terminal spaces)
+ $retstr .= " " if length $trailing_and;
+ $retstr .= $trailing_and;
return $retstr;
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
https://perl5.git.perl.org / perl5.git / blobdiff