diff options
Diffstat (limited to 'pod/pod2html')
| -rw-r--r-- | pod/pod2html | 209 |
1 files changed, 209 insertions, 0 deletions
diff --git a/pod/pod2html b/pod/pod2html new file mode 100644 index 0000000000..1bfc8f6a6a --- /dev/null +++ b/pod/pod2html @@ -0,0 +1,209 @@ +#!../perl + +# The beginning of the url for the anchors to the other sections. +chop($wd=`pwd`); +$type="<A HREF=\"file://localhost".$wd."/"; +$debug=0; +$/ = ""; +$p=\%p; +@exclusions=("perldebug","perlform","perlobj","perlstyle","perltrap","perlmod"); +$indent=0; +opendir(DIR,"."); +@{$p->{"pods"}}=grep(/\.pod$/,readdir(DIR)); +closedir(DIR); + +# learn the important stuff + +foreach $tmpod (@{$p->{"pods"}}){ + ($pod=$tmpod)=~s/\.pod$//; + $p->{"podnames"}->{$pod}=1; + next if grep(/$pod/,@exclusions); + open(POD,"<$tmpod"); + while(<POD>){ + s/B<([^<>]*)>/$1/g; # bold + s/I<([^<>]*)>/$1/g; # bold + if (s/^=//) { + s/\n$//s; + s/\n/ /g; + ($cmd, $_) = split(' ', $_, 2); + if ($cmd eq "item") { + ($what,$rest)=split(' ', $_, 2); + $what=~s#(-.).*#$1#; + $what=~s/\s*$//; + next if defined $p->{"items"}->{$what}; + $p->{"items"}->{$what} = $pod."_".$i++; + } + elsif($cmd =~ /^head/){ + $_=~s/\s*$//; + next if defined($p->{"headers"}->{$_}); + $p->{"headers"}->{$_} = $pod."_".$i++; + } + } + } +} + +$/=""; + +# parse the pods, produce html +foreach $tmpod (@{$p->{"pods"}}){ + open(POD,"<$tmpod") || die "cant open $pod"; + ($pod=$tmpod)=~s/\.pod$//; + open(HTML,">$pod.html"); + print HTML "<!-- \$RCSfile\$\$Revision\$\$Date\$ -->\n"; + print HTML "<!-- \$Log\$ -->\n"; + print HTML "<HTML>\n"; + print HTML "<TITLE> \U$pod\E </TITLE>\n"; + $cutting = 1; + while (<POD>) { + if ($cutting) { + next unless /^=/; + $cutting = 0; + } + chop; + length || (print "\n") && next; + # Translate verabatim paragraph + + if (/^\s/) { + $unordered=0; + &pre_escapes; + &post_escapes; + @lines = split(/\n/); + if($lines[0]=~/^\s+(\w*)\t(.*)/){ # listing or unordered list + ($key,$rest)=($1,$2); + if(defined($p->{"podnames"}->{$key})){ + print HTML "\n<ul>\n"; + $unordered = 1; + } + else{ + print HTML "\n<listing>\n"; + } + foreach $line (@lines){ + ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rest)=($1,$2)); + print HTML defined($p->{"podnames"}->{$key}) ? + "<li>$type$key.html\">$key<\/A>\t$rest\n" : "$line \n"; + } + print HTML $unordered ? "</ul>\n" : "</listing>\n"; + next; + }else{ # preformatted text + print HTML "<pre>\n"; + for(@lines){ + s/^/ /; + s/\t/ /g; + print HTML $_,"\n"; + } + print HTML "</pre>\n"; + next; + } + } + &pre_escapes; + s/S<([^<>]*)>/$1/g; # embedded special + $_ = &Do_refs($_,$pod); + s/Z<>/<p>/g; # ? + s/E<([^<>]*)>/\&$1\;/g; # embedded special + &post_escapes; + if (s/^=//) { + s/\n$//s; + s/\n/ /g; + ($cmd, $_) = split(' ', $_, 2); + if ($cmd eq 'cut') { + $cutting = 1; + } + elsif ($cmd eq 'head1') { + print HTML qq{<h2>$_</h2>\n}; + } + elsif ($cmd eq 'head2') { + print HTML qq{<h3>$_</h3>\n}; + } + elsif ($cmd eq 'over') { + push(@indent,$indent); + $indent = $_ + 0; + print HTML qq{\n<dl>\n}; + } + elsif ($cmd eq 'back') { + $indent = pop(@indent); + warn "Unmatched =back\n" unless defined $indent; + $needspace = 1; + print HTML qq{\n</dl>\n\n}; + } + elsif ($cmd eq 'item') { + ($what,$rest)=split(' ', $_, 2); + $what=~s/\s*$//; + if($justdid ne $what){ + print HTML "\n<A NAME=\"".$p->{"items"}->{$what}."\"></A>\n"; + $justdid=$what; + } + print HTML qq{<dt><B>$_</B> </dt>\n}; + $next_para=1; + } + else { + warn "Unrecognized directive: $cmd\n"; + } + } + else { + length || next; + $next_para && (print HTML qq{<dd>\n}); + print HTML "$_<p>"; + $next_para && (print HTML qq{</dd>\n<p>\n}) && ($next_para=0); + } + } +} +print HTML "\n</HTML>\n"; + +######################################################################### + +sub pre_escapes { + s/\&/\&\;/g; + s/<</\<\;\<\;/g; + s/([^ESIBLCF])</$1\<\;/g; +} + +sub post_escapes{ + s/>>/\>\;\>\;/g; + s/([^"AIB])>/$1\>\;/g; +} + +sub Do_refs{ +local($para,$pod)=@_; +foreach $char ("L","C","I","B"){ + next unless /($char<[^<>]*>)/; + local(@ar) = split(/($char<[^<>]*>)/,$para); + local($this,$key,$num); + for($this=0;$this<=$#ar;$this++){ + next unless $ar[$this] =~ /${char}<([^<>]*)>/; + $key=$1; + + if((defined($p->{"podnames"}->{$key})) && ($char eq "L")){ + $ar[$this] = "\n$type$key.html\">\nthe $key manpage<\/A>\n"; # + } + elsif(defined($p->{"items"}->{$key})){ + ($pod2,$num)=split(/_/,$p->{"items"}->{$key},2); + $ar[$this] = (($pod2 eq $pod) && ($para=~/^\=item/)) ? + "\n<A NAME=\"".$p->{"items"}->{$key}."\">\n$key</A>\n" + : + "\n$type$pod2.html\#".$p->{"items"}->{$key}."\">$key<\/A>\n"; + } + elsif(defined($p->{"headers"}->{$key})){ + ($pod2,$num)=split(/_/,$p->{"headers"}->{$key},2); + $ar[$this] = (($pod eq $pod2) && ($para=~/^\=head/)) ? + "\n<A NAME=\"".$p->{"headers"}->{$key}."\">\n$key</A>\n" + : + "\n$type$pod2.html\#".$p->{"headers"}->{$key}."\">$key<\/A>\n"; + } + else{ + (warn "No \"=item\" or \"=head\" reference for $ar[$this] in $pod\n") if $debug; + if($char =~ /^[BCF]$/){ + $ar[$this]="<B>$key</B>"; + } + elsif($char eq "L"){ + $ar[$this]=$key; + } + elsif($char eq "I"){ + $ar[$this]="<I>$key</I>"; + } + } + } + $para=join('',@ar); +} +$para; +} +sub wait{1;} |