Patch for perl.pod

[p5sagit/p5-mst-13.2.git] / pod / pod2man.PL

diff --git a/pod/pod2man.PL b/pod/pod2man.PL
index 68121e4..bd4dd41 100644 (file)
--- a/pod/pod2man.PL
+++ b/pod/pod2man.PL
@@ -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' or $^O eq 'amigaos');  # "case-forgiving"
+chdir dirname($0);
+$file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
 
 open OUT,">$file" or die "Can't create $file: $!";
 
@@ -28,6 +28,8 @@ print OUT <<"!GROK!THIS!";
 $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.
@@ -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
@@ -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}) {
@@ -405,14 +416,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;
 }
@@ -608,11 +627,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
@@ -637,6 +667,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();
 
@@ -658,18 +704,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]+
@@ -805,6 +849,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};
        }
@@ -831,7 +880,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")
@@ -915,13 +964,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\\&});
 }