X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pod%2Fpod2man.PL;h=d1ba2287cd9b67b8713c0423cc0d65562119269e;hb=54f70fc60d33628464c2f1f4a555eb6764959916;hp=5d1e193a345977782a30ee5c59ea82e56e160b27;hpb=44a8e56aa037ed0f03f0506f6f85f5ed290c78e1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pod/pod2man.PL b/pod/pod2man.PL
index 5d1e193..d1ba228 100644
--- a/pod/pod2man.PL
+++ b/pod/pod2man.PL
@@ -14,6 +14,7 @@ use File::Basename qw(&basename &dirname);
 # This is so that make depend always knows where to find PL derivatives.
 chdir dirname($0);
 $file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
 
 open OUT,">$file" or die "Can't create $file: $!";
 
@@ -45,6 +46,7 @@ B<pod2man>
 [ B<--date=>I<string> ]
 [ B<--fixed=>I<font> ]
 [ B<--official> ]
+[ B<--lax> ]
 I<inputfile>
 
 =head1 DESCRIPTION
@@ -104,6 +106,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
@@ -328,6 +334,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 @_;
@@ -340,6 +347,7 @@ Options are:
 	--date=string         (default "$DEF_DATE")
 	--fixed=font	      (default "$DEF_FIXED")
 	--official	      (default NOT)
+	--lax                 (default NOT)
 EOF
 }
 
@@ -350,6 +358,7 @@ $uok = GetOptions( qw(
 	date=s
 	fixed=s
 	official
+	lax
 	help));
 
 $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
@@ -361,6 +370,7 @@ usage("Need one and only one podpage argument") unless @ARGV == 1;
 $section = $opt_section || ($ARGV[0] =~ /\.pm$/ ? 3 : $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;
 
@@ -403,14 +413,15 @@ if ($name ne 'something') {
 		unless (/\s*-+\s+/) {
 		    $oops++;
 		    warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
-		}
-		%namedesc = split /\s+-+\s+/;
+                  } else {
+                    %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;
 }
@@ -683,18 +694,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]+
@@ -830,6 +839,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};
 	}
@@ -856,7 +870,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")
@@ -940,13 +954,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\\&});
 }