Update pod2html

> [...]
> # Lost interest?  It's so bad I've lost apathy.

You too, eh?

However, here's a patch which brings the _91 version up to date.

YES, it still slurps chunks.      ( No comment )

YES, it still uses XMP.           (Nothing else works right)

YES, it still is hard to follow.  (But oh, the joy of figuring it out!)

YES, it works on all platforms with configuration, including Macs...

I had pretty much given up on this, just telling people to grab
the latest from my CPAN dir, but I get alot of mail with fixes
against 1.15, and this is version is vastly better...  Please
try it, and apply to 5.004, if it's not too late.

I will (respectfully) ignore any whining about the inappropriateness
of some of the things I had to do in here.  Also any comments 
about other renditions, I've tried them all, and this one still 
excels; besides working on all platforms.  I'm in the middle of a 
rather difficult project, and I took the day off today to get this 
together.  

p5p-msgid: 199703030025.QAA08106@ducks

1 files changed, 200 insertions, 65 deletions

diff --git a/pod/pod2html.PL b/pod/pod2html.PL
index 602a866e42..beb304b44b 100644
--- a/pod/pod2html.PL
+++ b/pod/pod2html.PL
@@ -32,10 +32,12 @@ $Config{startperl}
 # In the following, perl variables are not expanded during extraction.
 
 print OUT <<'!NO!SUBS!';
+require "find.pl";
+use Config; # somday when we'll have $Config{installhtmldir}... 
 
 #
 # pod2html - convert pod format to html
-# Version 1.15
+# Version 1.21
 # usage: pod2html [podfiles]
 # Will read the cwd and parse all files with .pod extension
 # if no arguments are given on the command line.
@@ -45,11 +47,11 @@ print OUT <<'!NO!SUBS!';
 #
 # Please send patches/fixes/features to me
 #
-#
 # 
 *RS = */;
 *ERRNO = *!;
 
+
 ################################################################################
 # Invoke with various levels of debugging possible
 ################################################################################
@@ -64,67 +66,151 @@ while ($ARGV[0]) {
 }
 
 ################################################################################
-# CONFIGURE
-#
+# CONFIGURE -  change the following to suit your OS and taste
+################################################################################
 # The beginning of the url for the anchors to the other sections.
 # Edit $type to suit.  It's configured for relative url's now.
 # Other possibilities are:
 # $type = '<A HREF="file://localhost/usr/local/htmldir/'; # file url
 # $type = '<A HREF="http://www.bozo.com/perl/manual/html/' # server
-#
-################################################################################
 
 $type = '<A HREF="';		
-$dir = ".";             # location of pods
 
-# look in these pods for things not found within the current pod
+################################################################################
+# location of all podfiles unless on command line
+# $installprivlib="HD:usr:local:lib:perl5"; # uncomment and reset for Mac
+# $installprivlib="C:\usr\local\lib\perl5"; # uncomment and reset for DOS (I hope)
+
+# $installprivlib="/usr/local/lib/perl5"; # Unix
+$installprivlib="./"; # Standard perl pod directory for intallation
+
+################################################################################
+# Where to write out the html files
+# $installhtmldir="HD:usr:local:lib:perl5:html"; # uncomment and reset for Mac
+# $installhtmldir="C:\usr\local\lib\perl5\html"; # uncomment and reset for DOS (I hope)
+$installhtmldir = "./";  
+
+# test for validness
+
+if(!(-d $installhtmldir)){
+    print "Installation directory $installhtmldir does not exist, using cwd\n";
+    print "Hit ^C now to edit this script and configure installhtmldir\n";
+    $installhtmldir = '.';
+}
+
+################################################################################
+# the html extension, change to htm for DOS 
+
+$htmlext = "html"; 
+
+################################################################################
+# arbitrary name for this group of pods
+
+$package = "perl";  
+
+################################################################################
+# look in these pods for links to things not found within the current pod
 # be careful tho, namespace collisions cause stupid links
 
-@inclusions = qw[
-     perlfunc perlvar perlrun perlop 
-];
+@inclusions = qw[ perlfunc perlvar perlrun perlop ];
+
+################################################################################
+# Directory path separator
+# $sep= ":"; # uncomment for Mac 
+# $sep= "\"; # uncomment for DOS 
+
+$sep= "/";          
+
+################################################################################
+# Create 8.3 html files if this equals 1
+
+$DOSify=0;          
+
+################################################################################
+# Create maximum 32 character html files if this equals 1
+$MACify=0;
+
 ################################################################################
 # END CONFIGURE
+# Beyond here be dragons.  :-)
 ################################################################################
 
 $A = {};  # The beginning of all things
 
-unless (@Pods) {
-    opendir(DIR,$dir)  or  die "Can't opendir $dir: $ERRNO";
-    @Pods = grep(/\.pod$/,readdir(DIR));
-    closedir(DIR) or die "Can't closedir $dir: $ERRNO";
+unless(@Pods){  
+    find($installprivlib);
+    splice(@Pods,$#Pods+1,0,@modpods);;
 }
-@Pods or die "aak, expected pods";
 
+@Pods or die "aak, expected pods";
+open(INDEX,">".$installhtmldir.$sep."index.".$htmlext) or 
+	(die "cant open index.$htmlext");
+print INDEX "\n<HTML>\n<HEAD>\n<TITLE>Index of all pods for $package</TITLE></HEAD>\n<BODY>\n";
+print INDEX "<H1>Index of all pods for $package</H1>\n<hr><UL>\n";
 # loop twice through the pods, first to learn the links, then to produce html
 for $count (0,1) {
     print STDERR "Scanning pods...\n" unless $count;
+loop1:
     foreach $podfh ( @Pods ) {
-	($pod = $podfh) =~ s/\.(?:pod|pm)$//;
+	$didindex = 0;
+	$refname = $podfh;
+	$refname =~ s/$installprivlib${sep}?//;
+	$refname =~ s/${sep}/::/g;
+	$refname =~ s/\.p(m|od)$//;
+	$refname =~ s/^pod:://;
+	$savename = $refname;
+	$refname =~ s/::/_/g;  
+	if($DOSify && !$count){  # shorten the name for DOS
+	    (length($refname) > 8) and ( $refname = substr($refname,0,8));
+	    while(defined($DosNames{$refname})){
+        	@refname=split(//,$refname);
+		# allow 25 of em
+                ($refname[$#refname] eq "z") and ($refname[$#refname]  = "a");
+                $refname[$#refname]++;
+                $refname=join('',@refname);
+                $refname =~ s/\W/_/g;
+	    }
+	    $DosNames{$refname} = 1;
+	    $Podnames{$savename} = $refname . ".$htmlext";
+	}
+	elsif(!$DOSify and !$count){
+	    $Podnames{$savename} = $refname . ".$htmlext";
+	}
+        $pod = $savename;
 	Debug("files", "opening 2 $podfh" );
-	print "Creating $pod.html from $podfh\n" if $count;
+	print "Creating $Podnames{$savename} from $podfh\n" if $count;
 	$RS = "\n=";         # grok pods by item (Nonstandard but effecient)
 	open($podfh,"<".$podfh)  || die "can't open $podfh: $ERRNO";
 	@all = <$podfh>;
 	close($podfh);
 	$RS = "\n";
-
-	$all[0] =~ s/^=//;
-	for (@all) { s/=$// }
-	$Podnames{$pod} = 1;
+        ($all[0] =~ s/^=//) || pop(@all);
+        for ($i=0;$i <= $#all;$i++){ splice(@all,$i+1,1) unless 
+			(($all[$i] =~ s/=$//) && ($all[$i+1] !~ /^cut/)) ; # whoa..
+	}
 	$in_list = 0;
-	$html = $pod.".html";
-	if ($count) {              # give us a html and rcs header
-	    open(HTML,">$html") || die "can't create $html: $ERRNO";
-	    print HTML '<!-- $Id$ -->',"\n",'<HTML><HEAD>',"\n";
-	    print HTML "<CENTER>" unless $NO_NS;
-	    print HTML "<TITLE>$pod</TITLE>";
-	    print HTML "</CENTER>" unless $NO_NS;
-	    print HTML "\n</HEAD>\n<BODY>";
+	unless (grep(/NAME/,@all)){
+	    print STDERR "NAME header not found in $podfh, skipping\n";
+	    #delete($Podnames{$savename});
+	    next loop1;
 	}
+	if ($count) {   
+	    next unless length($Podnames{$savename});
+	    open(HTML,">".$installhtmldir.$sep.$Podnames{$savename}) or 
+		(die "can't create $Podnames{$savename}: $ERRNO");
+        print HTML "<HTML><HEAD>";
+        print HTML "<TITLE>$refname</TITLE>\n</HEAD>\n<BODY>";
+    }
+
 	for ($i = 0; $i <= $#all; $i++) {       # decide what to do with each chunk
 	    $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ;
 	    ($cmd, $title, $rest) = ($1,$2,$3);
+	    if(length($cmd)){$cutting =0;}
+	    next if $cutting;
+	    if(($title  =~ /NAME/) and ($didindex == 0) and $count){
+		print INDEX "<LI><A HREF=\"$Podnames{$savename}\">$rest</A>\n";
+		$didindex=1;
+	    }
 	    if ($cmd eq "item") {
 		if ($count ) { # producing html
 		    do_list("over",$all[$i],\$in_list,\$depth) unless $depth;
@@ -152,7 +238,7 @@ for $count (0,1) {
 		if ($count) {  # producing html
 		    ($depth) or next; # just skip it
 		    do_list("back",$all[$i+1],\$in_list,\$depth);
-		    do_rest($title.$rest);
+		    do_rest("$title$rest");
 		}
 	    }
 	    elsif ($cmd =~ /^cut/) {
@@ -162,7 +248,7 @@ for $count (0,1) {
                 if ($count) {  # producing html
                     if ($title =~ s/^html//) {
                         $in_html =1;
-                        do_rest($title.$rest);
+                        do_rest("$title$rest");
                     }
                 }
             }
@@ -189,6 +275,7 @@ for $count (0,1) {
 	}
     }
 }
+print INDEX "\n</UL></BODY>\n</HTML>\n";
 
 sub do_list{   # setup a list type, depending on some grok logic
     my($which,$next_one,$list_type,$depth) = @_;
@@ -210,7 +297,7 @@ sub do_list{   # setup a list type, depending on some grok logic
 	}
 
 	print HTML qq{\n};
-	print HTML $$list_type eq 'DL' ? qq{<DL COMPACT>} : qq{<$$list_type>};
+	print HTML qq{<$$list_type>};
 	$$depth++;
     }
     elsif ($which eq "back") {
@@ -221,28 +308,57 @@ sub do_list{   # setup a list type, depending on some grok logic
 
 sub do_hdr{   # headers
     my($num,$title,$rest,$depth) = @_;
+    my($savename,$restofname);
     print HTML qq{<p><hr>\n} if $num == 1;
+    ($savename = $title) =~ s/^(\w+)([\s,]+.*)/$1/;
+    $restofname = $2;
+    (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0);
     process_thing(\$title,"NAME");
     print HTML qq{\n<H$num> };
-    print HTML $title; 
+    if($savename){
+	print HTML "<A HREF=\"$Podnames{$savename}\">$savename$restofname</A>"; 
+    }
+    else{
+        print HTML $title; 
+    }
     print HTML qq{</H$num>\n};
     do_rest($rest);
 }
 
 sub do_item{  # list items
     my($title,$rest,$list_type) = @_;
-    my $bullet_only = $title eq '*' and $list_type eq 'UL';
+    my $bullet_only;
+    $bullet_only = ($title eq '*' and $list_type eq 'UL') ? 1 : 0;
+    my($savename);
+    $savename = $title;
+    (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0);
     process_thing(\$title,"NAME");
     if ($list_type eq "DL") {
-	print HTML qq{\n<DT><STRONG>\n};
-	print HTML $title; 
-	print HTML qq{\n</STRONG>\n};
+	print HTML qq{\n<DT>\n};
+	if($savename){
+	    print HTML "<A HREF=\"$Podnames{$savename}\">$savename $rest</A>\n</DT>"; 
+	}
+
+	else{
+	    (print HTML qq{\n<STRONG>\n}) unless ($title =~ /STRONG/);
+	    print HTML $title; 
+		if($title !~ /STRONG/){
+        	print HTML "\n</STRONG></DT>\n";
+		} else {
+			print HTML "</DT>\n";
+		}
+	}
 	print HTML qq{<DD>\n};
     }
     else {
 	print HTML qq{\n<LI>};
 	unless ($bullet_only or $list_type eq "OL") {
-	    print HTML $title,"\n";
+	    if($savename){
+		print HTML "<A HREF=\"$savename.$htmlext\">$savename</A>"; 
+	    }
+	    else{
+		print HTML $title,"\n";
+	    }
 	}
     }
     do_rest($rest);
@@ -265,7 +381,7 @@ sub do_rest{   # the rest of the chunk handled here
 	    foreach $line (@lines) { 
 		($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2));
 		print HTML defined($Podnames{$key}) 
-				?  "<LI>$type$key.html\">$key<\/A>\t$rem</LI>\n" 
+				?  "<LI>$type$Podnames{$key}\">$key<\/A>\t$rem</LI>\n" 
 				: "<LI>$line</LI>\n";
 	    }
 	    print HTML qq{</UL>\n};
@@ -276,7 +392,7 @@ sub do_rest{   # the rest of the chunk handled here
 		$inpre=1;
 	    }
 	    else {                         # Still cant beat XMP.  Yes, I know 
-		print HTML qq{\n<XMP>\n}; # it's been obsoleted... suggestions?
+		print HTML qq{\n<XMP>\n};      # it's been obsoleted... suggestions?
 		$inpre = 0;
 	    }
 	    while (defined($paras[$p])) {
@@ -305,6 +421,7 @@ sub do_rest{   # the rest of the chunk handled here
 	    @lines = split(/\n/,$paras[$p]);
 	    foreach $line (@lines) {
                 process_thing(\$line,"HTML");
+		$line =~ s/STRONG([^>])/STRONG>$1/;  # lame attempt to fix strong
 		print HTML qq{$line\n};
 	    }
 	}
@@ -323,7 +440,6 @@ sub scan_thing{           # scan a chunk for later references
     my($cmd,$title,$pod) = @_;
     $_ = $title;
     s/\n$//;
-    s/E<(\d+)>/&#$1;/g;
     s/E<(.*?)>/&$1;/g;
     # remove any formatting information for the headers
     s/[SFCBI]<(.*?)>/$1/g;         
@@ -380,21 +496,27 @@ sub picrefs {
 	    } 
 	} 
 	if (length($key)) {
-            ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/;
+		($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/;
 	    if ($htype eq "NAME") {  
-		return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
+			return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
 	    }
 	    else {
-		return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n";
+                1; # break here
+			return "\n$type$Podnames{$pod2}\#".$value."\">$bigkey<\/A>\n";
 	    }
 	} 
     }
     if ($char =~ /[IF]/) {
 	return "<EM>$bigkey</EM>";
     } elsif ($char =~ /C/) {
-	return "<CODE>$bigkey</CODE>";
+		return "<CODE>$bigkey</CODE>";
     } else {
-	return "<STRONG>$bigkey</STRONG>";
+		if($bigkey =~ /STRONG/){
+	    	return $bigkey;
+		}
+		else {
+	    	return "<STRONG>$bigkey</STRONG>";
+		}
     }
 } 
 
@@ -436,7 +558,7 @@ sub lrefs {
     $item =~ s/\(\)$//;
     if (!$item) {
     	if (!defined $section && defined $Podnames{$page}) {
-	    return "\n$type$page.html\">\nthe <EM>$page</EM> manpage<\/A>\n";
+	    return "\n$type$Podnames{$page}\">\nthe <EM>$page</EM> manpage<\/A>\n";
 	} else {
 	    (warn "Bizarre entry $page/$item") if $Debug;
 	    return "the <EM>$_[0]</EM>  manpage\n";
@@ -454,18 +576,18 @@ sub lrefs {
 	undef $value;
 	if ($ref eq "Items") {
 	    if (defined($value = $A->{$podname}->{$ref}->{$item})) {
-		($pod2,$num) = split(/_/,$value,2);
-		return (($pod eq $pod2) && ($htype eq "NAME"))
-	    	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
-	    	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
-            }
-        } 
+			($pod2,$num) = split(/_/,$value,2);  # break here
+			return (($pod eq $pod2) && ($htype eq "NAME"))
+	    		? "\n<A NAME=\"".$value."\">\n$text</A>\n"
+	    		: "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n";
+        }
+    } 
 	elsif ($ref eq "Headers") {
 	    if (defined($value = $A->{$podname}->{$ref}->{$item})) {
-		($pod2,$num) = split(/_/,$value,2);
+		($pod2,$num) = split(/_/,$value,2); # break here
 		return (($pod eq $pod2) && ($htype eq "NAME")) 
 	    	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
-	    	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
+	    	: "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n";
             }
 	}
     }
@@ -481,11 +603,16 @@ sub varrefs {
 	    Debug("vars", "way cool -- var ref on $var");
 	    return (($pod eq $pod2) && ($htype eq "NAME"))  # INHERIT $_, $pod
 		? "\n<A NAME=\"".$value."\">\n$var</A>\n"
-		: "\n$type$pod2.html\#".$value."\">$var<\/A>\n";
+		: "\n$type$Podnames{$pod2}\#".$value."\">$var<\/A>\n";
 	}
     }
     Debug( "vars", "bummer, $var not a var");
-    return "<STRONG>$var</STRONG>";
+    if($var =~ /STRONG/){
+		return $var;
+    }
+    else{
+		return "<STRONG>$var</STRONG>";
+    }
 } 
 
 sub gensym {
@@ -503,13 +630,13 @@ sub gensym {
 sub pre_escapes {  # twiddle these, and stay up late  :-)
     my($thing) = @_;
     for ($$thing) { 
-    s/([\200-\377])/noremap("&#".ord($1).";")/ge;
-	s/"(.*?)"/``$1''/gs;
-	s/&/noremap("&amp;")/ge;
-	s/<</noremap("&lt;&lt;")/eg;
-	s/([^ESIBLCF])</$1\&lt\;/g;
-	s/E<(\d+)>/\&#$1\;/g;                     # embedded numeric special
-	s/E<([^\/][^<>]*)>/\&$1\;/g;              # embedded special
+		s/([\200-\377])/noremap("&#".ord($1).";")/ge;
+		s/"(.*?)"/``$1''/gs;
+		s/&/noremap("&amp;")/ge;
+		s/<</noremap("&lt;&lt;")/eg;
+		s/([^ESIBLCF])</$1\&lt\;/g;
+		s/E<(\d+)>/\&#$1\;/g;                     # embedded numeric special
+		s/E<([^\/][^<>]*)>/\&$1\;/g;              # embedded special
     }
 }
 sub noremap {   # adding translator for hibit chars soon
@@ -546,6 +673,14 @@ sub trim {
         s/\s\n?$//;
     }
 }
+sub wanted {
+    my $name = $name;
+    if (-f $_) {
+        if ($name =~ /\.p(m|od)$/){
+            push(@modpods, $name) if ($name =~ /\.p(m|od)$/);
+	}
+    }
+}
 !NO!SUBS!
 
 close OUT or die "Can't close $file: $!";