From: William Middleton Date: Mon, 3 Mar 1997 00:25:03 +0000 (-0800) Subject: Update pod2html X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=90841c69f02b801a9d408ee4b2ed3da4664a144d;p=p5sagit%2Fp5-mst-13.2.git 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 --- diff --git a/pod/pod2html.PL b/pod/pod2html.PL index 602a866..b08aa60 100644 --- a/pod/pod2html.PL +++ b/pod/pod2html.PL @@ -1,4 +1,6 @@ #!/usr/local/bin/perl +require "find.pl"; +use Config; # somday when we'll have $Config{installhtmldir}... use Config; use File::Basename qw(&basename &dirname); @@ -35,7 +37,7 @@ print OUT <<'!NO!SUBS!'; # # 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 = '".$installhtmldir.$sep."index.".$htmlext) or + (die "cant open index.$htmlext"); +print INDEX "\n\n\nIndex of all pods for $package\n\n"; +print INDEX "

Index of all pods for $package

\n
\n\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{
} : 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{

\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 }; - print HTML $title; + if($savename){ + print HTML "$savename$restofname"; + } + else{ + print HTML $title; + } print HTML qq{\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
\n}; - print HTML $title; - print HTML qq{\n\n}; + print HTML qq{\n
\n}; + if($savename){ + print HTML "$savename $rest\n
"; + } + + else{ + (print HTML qq{\n\n}) unless ($title =~ /STRONG/); + print HTML $title; + if($title !~ /STRONG/){ + print HTML "\n\n"; + } else { + print HTML "\n"; + } + } print HTML qq{
\n}; } else { print HTML qq{\n
  • }; unless ($bullet_only or $list_type eq "OL") { - print HTML $title,"\n"; + if($savename){ + print HTML "$savename"; + } + 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}) - ? "
  • $type$key.html\">$key<\/A>\t$rem
    • \n" + ? "
  • $type$Podnames{$key}\">$key<\/A>\t$rem
    • \n" : "
  • $line
    • \n"; } print HTML qq{\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\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: $!";