pod/pod2html

   1 #!../perl
   2
   3 # The beginning of the url for the anchors to the other sections.
   4 chop($wd=`pwd`);
   5 $type="<A HREF=\"file://localhost".$wd."/";
   6 $debug=0;
   7 $/ = "";
   8 $p=\%p;
   9 @exclusions=("perldebug","perlform","perlobj","perlstyle","perltrap","perlmod");
  10 $indent=0;
  11 opendir(DIR,".");
  12 @{$p->{"pods"}}=grep(/\.pod$/,readdir(DIR));
  13 closedir(DIR);
  14
  15 # learn the important stuff
  16
  17 foreach $tmpod (@{$p->{"pods"}}){
  18     ($pod=$tmpod)=~s/\.pod$//;
  19     $p->{"podnames"}->{$pod}=1;
  20     next if grep(/$pod/,@exclusions);
  21     open(POD,"<$tmpod");
  22     while(<POD>){
  23         s/B<([^<>]*)>/$1/g;         # bold
  24         s/I<([^<>]*)>/$1/g;         # bold
  25         if (s/^=//) {
  26             s/\n$//s;
  27             s/\n/ /g;
  28             ($cmd, $_) = split(' ', $_, 2);
  29             if ($cmd eq  "item") {
  30                 ($what,$rest)=split(' ', $_, 2);
  31                 $what=~s#(-.).*#$1#;
  32                 $what=~s/\s*$//;
  33                 next if defined $p->{"items"}->{$what};
  34                 $p->{"items"}->{$what} = $pod."_".$i++;
  35             }
  36             elsif($cmd =~ /^head/){
  37                 $_=~s/\s*$//;
  38                 next if defined($p->{"headers"}->{$_});
  39                 $p->{"headers"}->{$_} = $pod."_".$i++;
  40             }
  41         }
  42     }
  43 }
  44
  45 $/="";
  46
  47 # parse the pods, produce html
  48 foreach $tmpod (@{$p->{"pods"}}){
  49     open(POD,"<$tmpod") || die "cant open $pod";
  50     ($pod=$tmpod)=~s/\.pod$//;
  51     open(HTML,">$pod.html");
  52     print HTML "<!-- \$RCSfile\$\$Revision\$\$Date\$ -->\n";
  53     print HTML "<!-- \$Log\$ -->\n";
  54     print HTML "<HTML>\n";
  55     print HTML "<TITLE> \U$pod\E </TITLE>\n";
  56     $cutting = 1;
  57     while (<POD>) {
  58         if ($cutting) {
  59             next unless /^=/;
  60             $cutting = 0;
  61         }
  62         chop;
  63         length || (print "\n") && next;
  64         # Translate verabatim paragraph
  65
  66         if (/^\s/) {
  67             $unordered=0;
  68             &pre_escapes;
  69             &post_escapes;
  70             @lines = split(/\n/);
  71             if($lines[0]=~/^\s+(\w*)\t(.*)/){  # listing or unordered list
  72                 ($key,$rest)=($1,$2);
  73                 if(defined($p->{"podnames"}->{$key})){
  74                     print HTML "\n<ul>\n";
  75                     $unordered = 1;
  76                 }
  77                 else{
  78                     print HTML  "\n<listing>\n";
  79                 }
  80                 foreach $line (@lines){
  81                     ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rest)=($1,$2));
  82                     print HTML defined($p->{"podnames"}->{$key}) ?
  83                         "<li>$type$key.html\">$key<\/A>\t$rest\n" : "$line \n";
  84                 }
  85                 print HTML $unordered ? "</ul>\n" : "</listing>\n";
  86                 next;
  87             }else{                 # preformatted text
  88                 print HTML "<pre>\n";
  89                 for(@lines){
  90                     s/^/    /;
  91                     s/\t/        /g;
  92                     print HTML  $_,"\n";
  93                 }
  94             print  HTML "</pre>\n";
  95             next;
  96             }
  97         }
  98         &pre_escapes;
  99         s/S<([^<>]*)>/$1/g;              # embedded special
 100         $_ = &Do_refs($_,$pod);
 101         s/Z<>/<p>/g; # ?
 102         s/E<([^<>]*)>/\&$1\;/g;              # embedded special
 103         &post_escapes;
 104         if (s/^=//) {
 105             s/\n$//s;
 106             s/\n/ /g;
 107             ($cmd, $_) = split(' ', $_, 2);
 108             if ($cmd eq 'cut') {
 109                 $cutting = 1;
 110             }
 111             elsif ($cmd eq 'head1') {
 112                 print HTML  qq{<h2>$_</h2>\n};
 113             }
 114             elsif ($cmd eq 'head2') {
 115                 print  HTML qq{<h3>$_</h3>\n};
 116             }
 117             elsif ($cmd eq 'over') {
 118                 push(@indent,$indent);
 119                 $indent = $_ + 0;
 120                 print HTML  qq{\n<dl>\n};
 121             }
 122             elsif ($cmd eq 'back') {
 123                 $indent = pop(@indent);
 124                 warn "Unmatched =back\n" unless defined $indent;
 125                 $needspace = 1;
 126                 print HTML qq{\n</dl>\n\n};
 127             }
 128             elsif ($cmd eq 'item') {
 129                 ($what,$rest)=split(' ', $_, 2);
 130                 $what=~s/\s*$//;
 131                 if($justdid ne $what){
 132                     print HTML "\n<A NAME=\"".$p->{"items"}->{$what}."\"></A>\n";
 133                     $justdid=$what;
 134                 }
 135                 print  HTML qq{<dt><B>$_</B> </dt>\n};
 136                 $next_para=1;
 137             }
 138             else {
 139                 warn "Unrecognized directive: $cmd\n";
 140             }
 141         }
 142         else {
 143             length || next;
 144             $next_para && (print HTML  qq{<dd>\n});
 145             print HTML  "$_<p>";
 146             $next_para && (print  HTML qq{</dd>\n<p>\n}) && ($next_para=0);
 147         }
 148     }
 149 }
 150 print HTML "\n</HTML>\n";
 151
 152 #########################################################################
 153
 154 sub pre_escapes {
 155     s/\&/\&amp\;/g;
 156     s/<</\&lt\;\&lt\;/g;
 157     s/([^ESIBLCF])</$1\&lt\;/g;
 158 }
 159
 160 sub post_escapes{
 161     s/>>/\&gt\;\&gt\;/g;
 162     s/([^"AIB])>/$1\&gt\;/g;
 163 }
 164
 165 sub Do_refs{
 166 local($para,$pod)=@_;
 167 foreach $char ("L","C","I","B"){
 168     next unless /($char<[^<>]*>)/;
 169     local(@ar) = split(/($char<[^<>]*>)/,$para);
 170     local($this,$key,$num);
 171     for($this=0;$this<=$#ar;$this++){
 172         next unless $ar[$this] =~ /${char}<([^<>]*)>/;
 173         $key=$1;
 174
 175         if((defined($p->{"podnames"}->{$key})) && ($char eq "L")){
 176             $ar[$this] = "\n$type$key.html\">\nthe $key manpage<\/A>\n"; #
 177         }
 178         elsif(defined($p->{"items"}->{$key})){
 179             ($pod2,$num)=split(/_/,$p->{"items"}->{$key},2);
 180                 $ar[$this] = (($pod2 eq $pod) && ($para=~/^\=item/)) ?
 181                 "\n<A NAME=\"".$p->{"items"}->{$key}."\">\n$key</A>\n"
 182                 :
 183                 "\n$type$pod2.html\#".$p->{"items"}->{$key}."\">$key<\/A>\n";
 184         }
 185         elsif(defined($p->{"headers"}->{$key})){
 186             ($pod2,$num)=split(/_/,$p->{"headers"}->{$key},2);
 187                 $ar[$this] = (($pod eq $pod2) && ($para=~/^\=head/)) ?
 188                 "\n<A NAME=\"".$p->{"headers"}->{$key}."\">\n$key</A>\n"
 189                 :
 190                 "\n$type$pod2.html\#".$p->{"headers"}->{$key}."\">$key<\/A>\n";
 191         }
 192         else{
 193             (warn "No \"=item\" or \"=head\" reference for $ar[$this] in $pod\n") if $debug;
 194             if($char =~ /^[BCF]$/){
 195                 $ar[$this]="<B>$key</B>";
 196             }
 197             elsif($char eq "L"){
 198                 $ar[$this]=$key;
 199             }
 200             elsif($char eq "I"){
 201                 $ar[$this]="<I>$key</I>";
 202             }
 203         }
 204     }
 205     $para=join('',@ar);
 206 }
 207 $para;
 208 }
 209 sub wait{1;}