pod/pod2html.SH

   1 case $CONFIG in
   2 '')
   3         if test -f config.sh; then TOP=.;
   4         elif test -f ../config.sh; then TOP=..;
   5         elif test -f ../../config.sh; then TOP=../..;
   6         elif test -f ../../../config.sh; then TOP=../../..;
   7         elif test -f ../../../../config.sh; then TOP=../../../..;
   8         else
   9                 echo "Can't find config.sh."; exit 1
  10         fi
  11         . $TOP/config.sh
  12         ;;
  13 esac
  14 case "$0" in
  15 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
  16 esac
  17 echo "Extracting pod/pod2html (with variable substitutions)"
  18 rm -f pod2html
  19 $spitshell >pod2html <<!GROK!THIS!
  20 #!$bin/perl
  21 eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  22         if \$running_under_some_shell;
  23 !GROK!THIS!
  24
  25 $spitshell >>pod2html <<'!NO!SUBS!'
  26 #
  27 # pod2html - convert pod format to html
  28 #
  29 # usage: pod2html [podfiles]
  30 # will read the cwd and parse all files with .pod extension
  31 # if no arguments are given on the command line.
  32 #
  33 *RS = */;
  34 *ERRNO = *!;
  35
  36 use Carp;
  37
  38 $gensym = 0;
  39
  40 while ($ARGV[0] =~ /^-d(.*)/) {
  41     shift;
  42     $Debug{ lc($1 || shift) }++;
  43 }
  44
  45 # look in these pods for things not found within the current pod
  46 @inclusions = qw[
  47      perlfunc perlvar perlrun perlop
  48 ];
  49
  50 # ck for podnames on command line
  51 while ($ARGV[0]) {
  52     push(@Pods,shift);
  53 }
  54 $A={};
  55
  56 # location of pods
  57 $dir=".";
  58
  59 # The beginning of the url for the anchors to the other sections.
  60 # Edit $type to suit.  It's configured for relative url's now.
  61 $type='<A HREF="';
  62 $debug = 0;
  63
  64 unless(@Pods){
  65     opendir(DIR,$dir)  or  die "Can't opendir $dir: $ERRNO";
  66     @Pods = grep(/\.pod$/,readdir(DIR));
  67     closedir(DIR) or die "Can't closedir $dir: $ERRNO";
  68 }
  69 @Pods or die "expected pods";
  70
  71 # loop twice through the pods, first to learn the links, then to produce html
  72 for $count (0,1){
  73     (print "Scanning pods...\n") unless $count;
  74     foreach $podfh ( @Pods ) {
  75         ($pod = $podfh) =~ s/\.pod$//;
  76         Debug("files", "opening 2 $podfh" );
  77         (print "Creating $pod.html from $podfh\n") if $count;
  78         $RS = "\n=";
  79         open($podfh,"<".$podfh)  || die "can't open $podfh: $ERRNO";
  80         @all=<$podfh>;
  81         close($podfh);
  82         $RS = "\n";
  83         $all[0]=~s/^=//;
  84         for(@all){s/=$//;}
  85         $Podnames{$pod} = 1;
  86         $in_list=0;
  87         $html=$pod.".html";
  88         if($count){
  89             open(HTML,">$html") || die "can't create $html: $ERRNO";
  90             print HTML <<'HTML__EOQ', <<"HTML__EOQQ";
  91             <!-- \$RCSfile\$\$Revision\$\$Date\$ -->
  92             <!-- \$Log\$ -->
  93             <HTML>
  94 HTML__EOQ
  95             <TITLE> \U$pod\E </TITLE>
  96 HTML__EOQQ
  97         }
  98
  99         for($i=0;$i<=$#all;$i++){
 100
 101             $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ;
 102             ($cmd, $title, $rest) = ($1,$2,$3);
 103             if ($cmd eq "item") {
 104                 if($count ){
 105                     ($depth) or do_list("over",$all[$i],\$in_list,\$depth);
 106                     do_item($title,$rest,$in_list);
 107                 }
 108                 else{
 109                     # scan item
 110                     scan_thing("item",$title,$pod);
 111                 }
 112             }
 113             elsif ($cmd =~ /^head([12])/){
 114                 $num=$1;
 115                 if($count){
 116                     do_hdr($num,$title,$rest,$depth);
 117                 }
 118                 else{
 119                     # header scan
 120                     scan_thing($cmd,$title,$pod); # skip head1
 121                 }
 122             }
 123             elsif ($cmd =~ /^over/) {
 124                 $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth);
 125             }
 126             elsif ($cmd =~ /^back/) {
 127                 if($count){
 128                     ($depth) or next; # just skip it
 129                     do_list("back",$all[$i+1],\$in_list,\$depth);
 130                     do_rest("$title.$rest");
 131                 }
 132             }
 133             elsif ($cmd =~ /^cut/) {
 134                 next;
 135             }
 136             elsif($Debug){
 137                 (warn "unrecognized header: $cmd") if $Debug;
 138             }
 139         }
 140         # close open lists without '=back' stmts
 141         if($count){
 142             while($depth){
 143                  do_list("back",$all[$i+1],\$in_list,\$depth);
 144             }
 145             print HTML "\n</HTML>\n";
 146         }
 147     }
 148 }
 149
 150 sub do_list{
 151     my($which,$next_one,$list_type,$depth)=@_;
 152     my($key);
 153     if($which eq "over"){
 154         ($next_one =~ /^item\s+(.*)/ ) or (warn "Bad list, $1\n") if $Debug;
 155         $key=$1;
 156         if($key =~ /^1\.?/){
 157         $$list_type = "OL";
 158         }
 159         elsif($key =~ /\*\s*$/){
 160         $$list_type="UL";
 161         }
 162         elsif($key =~ /\*?\s*\w/){
 163         $$list_type="DL";
 164         }
 165         else{
 166         (warn "unknown list type for item $key") if $Debug;
 167         }
 168         print HTML qq{\n};
 169         print HTML qq{<$$list_type>};
 170         $$depth++;
 171     }
 172     elsif($which eq "back"){
 173         print HTML qq{\n</$$list_type>\n};
 174         $$depth--;
 175     }
 176 }
 177
 178 sub do_hdr{
 179     my($num,$title,$rest,$depth)=@_;
 180     ($num == 1) and print HTML qq{<p><hr>\n};
 181     process_thing(\$title,"NAME");
 182     print HTML qq{\n<H$num> };
 183     print HTML $title;
 184     print HTML qq{</H$num>\n};
 185     do_rest($rest);
 186 }
 187
 188 sub do_item{
 189     my($title,$rest,$list_type)=@_;
 190     process_thing(\$title,"NAME");
 191     if($list_type eq "DL"){
 192         print HTML qq{\n<DT><STRONG>\n};
 193         print HTML $title;
 194         print HTML qq{\n</STRONG></DT>\n};
 195         print HTML qq{<DD>\n};
 196     }
 197     else{
 198         print HTML qq{\n<LI>};
 199         ($list_type ne "OL") && (print HTML $title,"\n");
 200     }
 201     do_rest($rest);
 202     print HTML ($list_type eq "DL" )? qq{</DD>} : qq{</LI>};
 203 }
 204
 205 sub do_rest{
 206     my($rest)=@_;
 207     my(@lines,$p,$q,$line,,@paras,$inpre);
 208     @paras=split(/\n\n+/,$rest);
 209     for($p=0;$p<=$#paras;$p++){
 210         @lines=split(/\n/,$paras[$p]);
 211         if($lines[0] =~ /^\s+\w*\t.*/){  # listing or unordered list
 212             print HTML qq{<UL>};
 213             foreach $line (@lines){
 214                 ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2));
 215                 print HTML defined($Podnames{$key}) ?
 216                     "<LI>$type$key.html\">$key<\/A>\t$rem</LI>\n" :
 217                         "<LI>$line</LI>\n";
 218             }
 219             print HTML qq{</UL>\n};
 220         }
 221         elsif($lines[0] =~ /^\s/){       # preformatted code
 222             if($paras[$p] =~/>>|<</){
 223                 print HTML qq{\n<PRE>\n};
 224                 $inpre=1;
 225             }
 226             else{
 227                 print HTML qq{\n<XMP>\n};
 228                 $inpre=0;
 229             }
 230 inner:
 231             while(defined($paras[$p])){
 232                 @lines=split(/\n/,$paras[$p]);
 233                 foreach $q (@lines){
 234                     if($paras[$p]=~/>>|<</){
 235                         if($inpre){
 236                             process_thing(\$q,"HTML");
 237                         }
 238                         else {
 239                             print HTML qq{\n</XMP>\n};
 240                             print HTML qq{<PRE>\n};
 241                             $inpre=1;
 242                             process_thing(\$q,"HTML");
 243                         }
 244                     }
 245                     while($q =~  s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e){
 246                         1;
 247                     }
 248                     print HTML  $q,"\n";
 249                 }
 250                 last if $paras[$p+1] !~ /^\s/;
 251                 $p++;
 252             }
 253             print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n});
 254         }
 255         else{                             # other text
 256             @lines=split(/\n/,$paras[$p]);
 257             foreach $line (@lines){
 258                 process_thing(\$line,"HTML");
 259                 print HTML qq{$line\n};
 260             }
 261         }
 262         print HTML qq{<p>};
 263     }
 264 }
 265
 266 sub process_thing{
 267     my($thing,$htype)=@_;
 268     pre_escapes($thing);
 269     find_refs($thing,$htype);
 270     post_escapes($thing);
 271 }
 272
 273 sub scan_thing{
 274     my($cmd,$title,$pod)=@_;
 275     $_=$title;
 276     s/\n$//;
 277     s/E<(.*?)>/&$1;/g;
 278     # remove any formatting information for the headers
 279     s/[SFCBI]<(.*?)>/$1/g;
 280     # the "don't format me" thing
 281     s/Z<>//g;
 282     if ($cmd eq "item") {
 283
 284         if (/^\*/)      {  return }     # skip bullets
 285         if (/^\d+\./)   {  return }     # skip numbers
 286         s/(-[a-z]).*/$1/i;
 287         trim($_);
 288         return if defined $A->{$pod}->{"Items"}->{$_};
 289         $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_);
 290         $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_};
 291         Debug("items", "item $_");
 292         if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_
 293             && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1))
 294         {
 295             $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_};
 296             Debug("items", "item $1 REF TO $_");
 297         }
 298         if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) {
 299             my $pf = $1 . '//';
 300             $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s";
 301             if ($pf ne $_) {
 302                 $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_};
 303                 Debug("items", "item $pf REF TO $_");
 304             }
 305         }
 306     }
 307     elsif ($cmd =~ /^head[12]/){
 308         return if defined($Headers{$_});
 309         $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_);
 310         Debug("headers", "header $_");
 311     }
 312     else {
 313         (warn "unrecognized header: $cmd") if $Debug;
 314     }
 315 }
 316
 317
 318 sub picrefs {
 319     my($char, $bigkey, $lilkey,$htype) = @_;
 320     my($key,$ref,$podname);
 321     for $podname ($pod,@inclusions){
 322         for $ref ( "Items", "Headers" ) {
 323             if (defined $A->{$podname}->{$ref}->{$bigkey}) {
 324                 $value = $A->{$podname}->{$ref}->{$key=$bigkey};
 325                 Debug("subs", "bigkey is $bigkey, value is $value\n");
 326             }
 327             elsif (defined $A->{$podname}->{$ref}->{$lilkey}) {
 328                 $value = $A->{$podname}->{$ref}->{$key=$lilkey};
 329                 return "" if $lilkey eq '';
 330                 Debug("subs", "lilkey is $lilkey, value is $value\n");
 331             }
 332         }
 333         if (length($key)) {
 334             ($pod2,$num) = split(/_/,$value,2);
 335             if($htype eq "NAME"){
 336                 return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
 337             }
 338             else{
 339                 return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n";
 340             }
 341         }
 342     }
 343     if ($char =~ /[IF]/) {
 344         return "<EM> $bigkey </EM>";
 345     } elsif($char =~ /C/) {
 346         return "<CODE> $bigkey </CODE>";
 347     } else {
 348         return "<STRONG> $bigkey </STRONG>";
 349     }
 350 }
 351
 352 sub find_refs {
 353     my($thing,$htype)=@_;
 354     my($orig) = $$thing;
 355     # LREF: a manpage(3f) we don't know about
 356     $$thing=~s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g;
 357     $$thing=~s/L<([^>]*)>/lrefs($1,$htype)/ge;
 358     $$thing=~s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
 359     $$thing=~s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge;
 360     $$thing=~s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge;
 361     (($$thing eq $orig) && ($htype eq "NAME")) &&
 362         ($$thing=picrefs("I", $$thing, "", $htype));
 363 }
 364
 365 sub lrefs {
 366     my($page, $item) = split(m#/#, $_[0], 2);
 367     my($htype)=$_[1];
 368     my($podname);
 369     my($section) = $page =~ /\((.*)\)/;
 370     my $selfref;
 371     if ($page =~ /^[A-Z]/ && $item) {
 372         $selfref++;
 373         $item = "$page/$item";
 374         $page = $pod;
 375     }  elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) {
 376         $selfref++;
 377         $item = $page;
 378         $page = $pod;
 379     }
 380     $item =~ s/\(\)$//;
 381     if (!$item) {
 382         if (!defined $section && defined $Podnames{$page}) {
 383             return "\n$type$page.html\">\nthe <EM> $page </EM> manpage<\/A>\n";
 384         } else {
 385             (warn "Bizarre entry $page/$item") if $Debug;
 386             return "the <EM> $_[0] </EM>  manpage\n";
 387         }
 388     }
 389
 390     if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
 391         $text = "<EM> $item </EM>";
 392         $ref = "Headers";
 393     } else {
 394         $text = "<EM> $item </EM>";
 395         $ref = "Items";
 396     }
 397     for $podname ($pod, @inclusions){
 398         undef $value;
 399         if ($ref eq "Items") {
 400             if (defined($value = $A->{$podname}->{$ref}->{$item})) {
 401                 ($pod2,$num) = split(/_/,$value,2);
 402                 return (($pod eq $pod2) && ($htype eq "NAME"))
 403                 ? "\n<A NAME=\"".$value."\">\n$text</A>\n"
 404                 : "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
 405             }
 406         }
 407         elsif($ref eq "Headers") {
 408             if (defined($value = $A->{$podname}->{$ref}->{$item})) {
 409                 ($pod2,$num) = split(/_/,$value,2);
 410                 return (($pod eq $pod2) && ($htype eq "NAME"))
 411                 ? "\n<A NAME=\"".$value."\">\n$text</A>\n"
 412                 : "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
 413             }
 414         }
 415     }
 416     (warn "No $ref reference for $item (@_)") if $Debug;
 417     return $text;
 418 }
 419
 420 sub varrefs {
 421     my ($var,$htype) = @_;
 422     for $podname ($pod,@inclusions){
 423         if ($value = $A->{$podname}->{"Items"}->{$var}) {
 424             ($pod2,$num) = split(/_/,$value,2);
 425             Debug("vars", "way cool -- var ref on $var");
 426             return (($pod eq $pod2) && ($htype eq "NAME"))  # INHERIT $_, $pod
 427                 ? "\n<A NAME=\"".$value."\">\n$var</A>\n"
 428                 : "\n$type$pod2.html\#".$value."\">$var<\/A>\n";
 429         }
 430     }
 431     Debug( "vars", "bummer, $var not a var");
 432     return "<STRONG> $var </STRONG>";
 433 }
 434
 435 sub gensym {
 436     my ($podname, $key) = @_;
 437     $key =~ s/\s.*//;
 438     ($key = lc($key)) =~ tr/a-z/_/cs;
 439     my $name = "${podname}_${key}_0";
 440     $name =~ s/__/_/g;
 441     while ($sawsym{$name}++) {
 442         $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
 443     }
 444     return $name;
 445 }
 446
 447 sub pre_escapes {
 448     my($thing)=@_;
 449     $$thing=~s/&/noremap("&amp;")/ge;
 450     $$thing=~s/<</noremap("&lt;&lt;")/eg;
 451     $$thing=~s/(?:[^ESIBLCF])</noremap("&lt;")/eg;
 452     $$thing=~s/E<([^\/][^<>]*)>/\&$1\;/g;              # embedded special
 453 }
 454
 455 sub noremap {
 456     my $hide = $_[0];
 457     $hide =~ tr/\000-\177/\200-\377/;
 458     $hide;
 459 }
 460
 461 sub post_escapes {
 462     my($thing)=@_;
 463     $$thing=~s/[^GM]>>/\&gt\;\&gt\;/g;
 464     $$thing=~s/([^"MGAE])>/$1\&gt\;/g;
 465     $$thing=~tr/\200-\377/\000-\177/;
 466 }
 467
 468 sub Debug {
 469     my $level = shift;
 470     print STDERR @_,"\n" if $Debug{$level};
 471 }
 472
 473 sub dumptable  {
 474     my $t = shift;
 475     print STDERR "TABLE DUMP $t\n";
 476     foreach $k (sort keys %$t) {
 477         printf STDERR "%-20s <%s>\n", $t->{$k}, $k;
 478     }
 479 }
 480 sub trim {
 481     for (@_) {
 482         s/^\s+//;
 483         s/\s\n?$//;
 484     }
 485 }
 486
 487
 488 !NO!SUBS!
 489 chmod 755 pod2html
 490 $eunicefix pod2html