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 ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'amigaos'); # "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
$/ = "";
$cutting = 1;
+@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') {
- ($version,$patch) =
- `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
+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;
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 = 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 ^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: {
unless (/\s*-+\s+/) {
$oops++;
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
- die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n";
+ 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 documentation 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';
$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;
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 '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
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 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)
+ . " 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