ExtUtils/Miniperl.pm not built on Win32
[p5sagit/p5-mst-13.2.git] / pod / pod2man.PL
index 8c054ca..cd14ce2 100644 (file)
@@ -8,14 +8,14 @@ use File::Basename qw(&basename &dirname);
 # 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');  # "case-forgiving"
+chdir dirname($0);
+$file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
 
 open OUT,">$file" or die "Can't create $file: $!";
 
@@ -25,14 +25,16 @@ print "Extracting $file (with variable substitutions)\n";
 # 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
 
@@ -47,6 +49,7 @@ B<pod2man>
 [ B<--date=>I<string> ]
 [ B<--fixed=>I<font> ]
 [ B<--official> ]
+[ B<--lax> ]
 I<inputfile>
 
 =head1 DESCRIPTION
@@ -106,6 +109,10 @@ best if you put your Perl man pages in a separate tree, like
 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
@@ -198,7 +205,7 @@ Who wrote it (or AUTHORS if multiple).
 =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
 
@@ -248,7 +255,7 @@ not having a NAME is a fatal.
 =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,
@@ -273,7 +280,7 @@ C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
 
 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:
 
@@ -330,6 +337,7 @@ $DEF_SECTION = 1;
 $DEF_CENTER = "User Contributed Perl Documentation";
 $STD_CENTER = "Perl Programmers Reference Guide";
 $DEF_FIXED = 'CW';
+$DEF_LAX = 0;
 
 sub usage {
     warn "$0: @_\n" if @_;
@@ -342,6 +350,7 @@ Options are:
        --date=string         (default "$DEF_DATE")
        --fixed=font          (default "$DEF_FIXED")
        --official            (default NOT)
+       --lax                 (default NOT)
 EOF
 }
 
@@ -352,6 +361,7 @@ $uok = GetOptions( qw(
        date=s
        fixed=s
        official
+       lax
        help));
 
 $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
@@ -360,9 +370,11 @@ usage("Usage error!") unless $uok;
 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;
 
@@ -376,7 +388,6 @@ else {
     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}) {
@@ -388,8 +399,27 @@ $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
 
 $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 ^arch/version/.
+    $name =~ s-^[^/]+/\d+\.\d+/--;
+}
+
+# Translate Getopt/Long to Getopt::Long, etc.
+$name =~ s(/)(::)g;
 
 if ($name ne 'something') {
     FCHECK: {
@@ -401,14 +431,22 @@ if ($name ne 'something') {
                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";
+           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;
 }
@@ -604,11 +642,22 @@ END
 
 $indent = 0;
 
+$begun = "";
+
 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
@@ -633,6 +682,22 @@ while (<>) {
 
     $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();
 
@@ -654,18 +719,16 @@ while (<>) {
            )
        } {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]+
@@ -755,7 +818,7 @@ while (<>) {
                    ?  "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;
 
@@ -801,6 +864,11 @@ while (<>) {
        }
        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};
        }
@@ -827,7 +895,7 @@ print <<"END";
 .rn }` ''
 END
 
-if (%wanna_see) {
+if (%wanna_see && !$lax) {
     @missing = keys %wanna_see;
     warn "$0: $Filename is missing required section"
        .  (@missing > 1 && "s")
@@ -911,13 +979,7 @@ sub escapes {
 # 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\\&});
 }
 
@@ -1004,7 +1066,7 @@ sub internal_lrefs {
     }
 
     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
-           .  " elsewhere in this document";
+           .  " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
 
     return $retstr;