pod/pod2html.PL

   1 #!/usr/local/bin/perl
   2 require "find.pl";
   3 use Config; # somday when we'll have $Config{installhtmldir}...
   4
   5 use Config;
   6 use File::Basename qw(&basename &dirname);
   7
   8 # List explicitly here the variables you want Configure to
   9 # generate.  Metaconfig only looks for shell variables, so you
  10 # have to mention them as if they were shell variables, not
  11 # %Config entries.  Thus you write
  12 #  $startperl
  13 # to ensure Configure will look for $Config{startperl}.
  14
  15 # This forces PL files to create target in same directory as PL file.
  16 # This is so that make depend always knows where to find PL derivatives.
  17 chdir dirname($0);
  18 $file = basename($0, '.PL');
  19 $file .= '.com' if $^O eq 'VMS';
  20
  21 open OUT,">$file" or die "Can't create $file: $!";
  22
  23 print "Extracting $file (with variable substitutions)\n";
  24
  25 # In this section, perl variables will be expanded during extraction.
  26 # You can use $Config{...} to use Configure variables.
  27
  28 print OUT <<"!GROK!THIS!";
  29 $Config{startperl}
  30     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
  31         if \$running_under_some_shell;
  32 !GROK!THIS!
  33
  34 # In the following, perl variables are not expanded during extraction.
  35
  36 print OUT <<'!NO!SUBS!';
  37
  38 #
  39 # pod2html - convert pod format to html
  40 # Version 1.21
  41 # usage: pod2html [podfiles]
  42 # Will read the cwd and parse all files with .pod extension
  43 # if no arguments are given on the command line.
  44 #
  45 # Many helps, suggestions, and fixes from the perl5 porters, and all over.
  46 # Bill Middleton - wjm@metronet.com
  47 #
  48 # Please send patches/fixes/features to me
  49 #
  50 #
  51 *RS = */;
  52 *ERRNO = *!;
  53
  54
  55 ################################################################################
  56 # Invoke with various levels of debugging possible
  57 ################################################################################
  58 while ($ARGV[0] =~ /^-d(.*)/) {
  59     shift;
  60     $Debug{ lc($1 || shift) }++;
  61 }
  62
  63 # ck for podnames on command line
  64 while ($ARGV[0]) {
  65     push(@Pods,shift);
  66 }
  67
  68 ################################################################################
  69 # CONFIGURE -  change the following to suit your OS and taste
  70 ################################################################################
  71 # The beginning of the url for the anchors to the other sections.
  72 # Edit $type to suit.  It's configured for relative url's now.
  73 # Other possibilities are:
  74 # $type = '<A HREF="file://localhost/usr/local/htmldir/'; # file url
  75 # $type = '<A HREF="http://www.bozo.com/perl/manual/html/' # server
  76
  77 $type = '<A HREF="';
  78
  79 ################################################################################
  80 # location of all podfiles unless on command line
  81 # $installprivlib="HD:usr:local:lib:perl5"; # uncomment and reset for Mac
  82 # $installprivlib="C:\usr\local\lib\perl5"; # uncomment and reset for DOS (I hope)
  83
  84 # $installprivlib="/usr/local/lib/perl5"; # Unix
  85 $installprivlib="./"; # Standard perl pod directory for intallation
  86
  87 ################################################################################
  88 # Where to write out the html files
  89 # $installhtmldir="HD:usr:local:lib:perl5:html"; # uncomment and reset for Mac
  90 # $installhtmldir="C:\usr\local\lib\perl5\html"; # uncomment and reset for DOS (I hope)
  91 $installhtmldir = "./";
  92
  93 # test for validness
  94
  95 if(!(-d $installhtmldir)){
  96     print "Installation directory $installhtmldir does not exist, using cwd\n";
  97     print "Hit ^C now to edit this script and configure installhtmldir\n";
  98     $installhtmldir = '.';
  99 }
 100
 101 ################################################################################
 102 # the html extension, change to htm for DOS
 103
 104 $htmlext = "html";
 105
 106 ################################################################################
 107 # arbitrary name for this group of pods
 108
 109 $package = "perl";
 110
 111 ################################################################################
 112 # look in these pods for links to things not found within the current pod
 113 # be careful tho, namespace collisions cause stupid links
 114
 115 @inclusions = qw[ perlfunc perlvar perlrun perlop ];
 116
 117 ################################################################################
 118 # Directory path separator
 119 # $sep= ":"; # uncomment for Mac
 120 # $sep= "\"; # uncomment for DOS
 121
 122 $sep= "/";
 123
 124 ################################################################################
 125 # Create 8.3 html files if this equals 1
 126
 127 $DOSify=0;
 128
 129 ################################################################################
 130 # Create maximum 32 character html files if this equals 1
 131 $MACify=0;
 132
 133 ################################################################################
 134 # END CONFIGURE
 135 # Beyond here be dragons.  :-)
 136 ################################################################################
 137
 138 $A = {};  # The beginning of all things
 139
 140 unless(@Pods){
 141     find($installprivlib);
 142     splice(@Pods,$#Pods+1,0,@modpods);;
 143 }
 144
 145 @Pods or die "aak, expected pods";
 146 open(INDEX,">".$installhtmldir.$sep."index.".$htmlext) or
 147         (die "cant open index.$htmlext");
 148 print INDEX "\n<HTML>\n<HEAD>\n<TITLE>Index of all pods for $package</TITLE></HEAD>\n<BODY>\n";
 149 print INDEX "<H1>Index of all pods for $package</H1>\n<hr><UL>\n";
 150 # loop twice through the pods, first to learn the links, then to produce html
 151 for $count (0,1) {
 152     print STDERR "Scanning pods...\n" unless $count;
 153 loop1:
 154     foreach $podfh ( @Pods ) {
 155         $didindex = 0;
 156         $refname = $podfh;
 157         $refname =~ s/$installprivlib${sep}?//;
 158         $refname =~ s/${sep}/::/g;
 159         $refname =~ s/\.p(m|od)$//;
 160         $refname =~ s/^pod:://;
 161         $savename = $refname;
 162         $refname =~ s/::/_/g;
 163         if($DOSify && !$count){  # shorten the name for DOS
 164             (length($refname) > 8) and ( $refname = substr($refname,0,8));
 165             while(defined($DosNames{$refname})){
 166                 @refname=split(//,$refname);
 167                 # allow 25 of em
 168                 ($refname[$#refname] eq "z") and ($refname[$#refname]  = "a");
 169                 $refname[$#refname]++;
 170                 $refname=join('',@refname);
 171                 $refname =~ s/\W/_/g;
 172             }
 173             $DosNames{$refname} = 1;
 174             $Podnames{$savename} = $refname . ".$htmlext";
 175         }
 176         elsif(!$DOSify and !$count){
 177             $Podnames{$savename} = $refname . ".$htmlext";
 178         }
 179         $pod = $savename;
 180         Debug("files", "opening 2 $podfh" );
 181         print "Creating $Podnames{$savename} from $podfh\n" if $count;
 182         $RS = "\n=";         # grok pods by item (Nonstandard but effecient)
 183         open($podfh,"<".$podfh)  || die "can't open $podfh: $ERRNO";
 184         @all = <$podfh>;
 185         close($podfh);
 186         $RS = "\n";
 187         ($all[0] =~ s/^=//) || pop(@all);
 188         for ($i=0;$i <= $#all;$i++){ splice(@all,$i+1,1) unless
 189                         (($all[$i] =~ s/=$//) && ($all[$i+1] !~ /^cut/)) ; # whoa..
 190         }
 191         $in_list = 0;
 192         unless (grep(/NAME/,@all)){
 193             print STDERR "NAME header not found in $podfh, skipping\n";
 194             #delete($Podnames{$savename});
 195             next loop1;
 196         }
 197         if ($count) {
 198             next unless length($Podnames{$savename});
 199             open(HTML,">".$installhtmldir.$sep.$Podnames{$savename}) or
 200                 (die "can't create $Podnames{$savename}: $ERRNO");
 201         print HTML "<HTML><HEAD>";
 202         print HTML "<TITLE>$refname</TITLE>\n</HEAD>\n<BODY>";
 203     }
 204
 205         for ($i = 0; $i <= $#all; $i++) {       # decide what to do with each chunk
 206             $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ;
 207             ($cmd, $title, $rest) = ($1,$2,$3);
 208             if(length($cmd)){$cutting =0;}
 209             next if $cutting;
 210             if(($title  =~ /NAME/) and ($didindex == 0) and $count){
 211                 print INDEX "<LI><A HREF=\"$Podnames{$savename}\">$rest</A>\n";
 212                 $didindex=1;
 213             }
 214             if ($cmd eq "item") {
 215                 if ($count ) { # producing html
 216                     do_list("over",$all[$i],\$in_list,\$depth) unless $depth;
 217                     do_item($title,$rest,$in_list);
 218                 }
 219                 else {
 220                     # scan item
 221                     scan_thing("item",$title,$pod);
 222                 }
 223             }
 224             elsif ($cmd =~ /^head([12])/) {
 225                 $num = $1;
 226                 if ($count) { # producing html
 227                     do_hdr($num,$title,$rest,$depth);
 228                 }
 229                 else {
 230                     # header scan
 231                     scan_thing($cmd,$title,$pod); # skip head1
 232                 }
 233             }
 234             elsif ($cmd =~ /^over/) {
 235                 $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth);
 236             }
 237             elsif ($cmd =~ /^back/) {
 238                 if ($count) {  # producing html
 239                     ($depth) or next; # just skip it
 240                     do_list("back",$all[$i+1],\$in_list,\$depth);
 241                     do_rest("$title$rest");
 242                 }
 243             }
 244             elsif ($cmd =~ /^cut/) {
 245                 next;
 246             }
 247             elsif ($cmd =~ /^for/) {  # experimental pragma html
 248                 if ($count) {  # producing html
 249                     if ($title =~ s/^html//) {
 250                         $in_html =1;
 251                         do_rest("$title$rest");
 252                     }
 253                 }
 254             }
 255             elsif ($cmd =~ /^begin/) {  # experimental pragma html
 256                 if ($count) {  # producing html
 257                     if ($title =~ s/^html//) {
 258                         print HTML $title,"\n",$rest;
 259                     }
 260                     elsif ($title =~ /^end/) {
 261                         next;
 262                     }
 263                 }
 264             }
 265             elsif ($Debug{"misc"}) {
 266                 warn("unrecognized header: $cmd");
 267             }
 268         }
 269         # close open lists without '=back' stmts
 270         if ($count) {  # producing html
 271             while ($depth) {
 272                  do_list("back",$all[$i+1],\$in_list,\$depth);
 273             }
 274             print HTML "\n</BODY>\n</HTML>\n";
 275         }
 276     }
 277 }
 278 print INDEX "\n</UL></BODY>\n</HTML>\n";
 279
 280 sub do_list{   # setup a list type, depending on some grok logic
 281     my($which,$next_one,$list_type,$depth) = @_;
 282     my($key);
 283     if ($which eq "over") {
 284         unless ($next_one =~ /^item\s+(.*)/) {
 285             warn "Bad list, $1\n" if $Debug{"misc"};
 286         }
 287         $key = $1;
 288
 289         if      ($key =~ /^1\.?/) {
 290             $$list_type = "OL";
 291         } elsif ($key =~ /\*\s*$/) {
 292             $$list_type = "UL";
 293         } elsif ($key =~ /\*?\s*\w/) {
 294             $$list_type = "DL";
 295         } else {
 296             warn "unknown list type for item $key" if $Debug{"misc"};
 297         }
 298
 299         print HTML qq{\n};
 300         print HTML qq{<$$list_type>};
 301         $$depth++;
 302     }
 303     elsif ($which eq "back") {
 304         print HTML qq{\n</$$list_type>\n};
 305         $$depth--;
 306     }
 307 }
 308
 309 sub do_hdr{   # headers
 310     my($num,$title,$rest,$depth) = @_;
 311     my($savename,$restofname);
 312     print HTML qq{<p><hr>\n} if $num == 1;
 313     ($savename = $title) =~ s/^(\w+)([\s,]+.*)/$1/;
 314     $restofname = $2;
 315     (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0);
 316     process_thing(\$title,"NAME");
 317     print HTML qq{\n<H$num> };
 318     if($savename){
 319         print HTML "<A HREF=\"$Podnames{$savename}\">$savename$restofname</A>";
 320     }
 321     else{
 322         print HTML $title;
 323     }
 324     print HTML qq{</H$num>\n};
 325     do_rest($rest);
 326 }
 327
 328 sub do_item{  # list items
 329     my($title,$rest,$list_type) = @_;
 330     my $bullet_only;
 331     $bullet_only = ($title eq '*' and $list_type eq 'UL') ? 1 : 0;
 332     my($savename);
 333     $savename = $title;
 334     (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0);
 335     process_thing(\$title,"NAME");
 336     if ($list_type eq "DL") {
 337         print HTML qq{\n<DT>\n};
 338         if($savename){
 339             print HTML "<A HREF=\"$Podnames{$savename}\">$savename $rest</A>\n</DT>";
 340         }
 341
 342         else{
 343             (print HTML qq{\n<STRONG>\n}) unless ($title =~ /STRONG/);
 344             print HTML $title;
 345                 if($title !~ /STRONG/){
 346                 print HTML "\n</STRONG></DT>\n";
 347                 } else {
 348                         print HTML "</DT>\n";
 349                 }
 350         }
 351         print HTML qq{<DD>\n};
 352     }
 353     else {
 354         print HTML qq{\n<LI>};
 355         unless ($bullet_only or $list_type eq "OL") {
 356             if($savename){
 357                 print HTML "<A HREF=\"$savename.$htmlext\">$savename</A>";
 358             }
 359             else{
 360                 print HTML $title,"\n";
 361             }
 362         }
 363     }
 364     do_rest($rest);
 365 }
 366
 367 sub do_rest{   # the rest of the chunk handled here
 368     my($rest) = @_;
 369     my(@lines,$p,$q,$line,,@paras,$inpre);
 370     @paras = split(/\n\n\n*/,$rest);
 371     for ($p = 0; $p <= $#paras; $p++) {
 372         $paras[$p] =~ s/^\n//mg;
 373         @lines = split(/\n/,$paras[$p]);
 374         if ($in_html) {  # handle =for html paragraphs
 375             print HTML $paras[0];
 376             $in_html = 0;
 377             next;
 378         }
 379         elsif ($lines[0] =~ /^\s+\w*\t.*/) {  # listing or unordered list
 380             print HTML qq{<UL>};
 381             foreach $line (@lines) {
 382                 ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2));
 383                 print HTML defined($Podnames{$key})
 384                                 ?  "<LI>$type$Podnames{$key}\">$key<\/A>\t$rem</LI>\n"
 385                                 : "<LI>$line</LI>\n";
 386             }
 387             print HTML qq{</UL>\n};
 388         }
 389         elsif ($lines[0] =~ /^\s/) {       # preformatted code
 390             if ($paras[$p] =~/>>|<</) {
 391                 print HTML qq{\n<PRE>\n};
 392                 $inpre=1;
 393             }
 394             else {                         # Still cant beat XMP.  Yes, I know
 395                 print HTML qq{\n<XMP>\n};      # it's been obsoleted... suggestions?
 396                 $inpre = 0;
 397             }
 398             while (defined($paras[$p])) {
 399                 @lines = split(/\n/,$paras[$p]);
 400                 foreach $q (@lines) {      # mind your p's and q's here :-)
 401                     if ($paras[$p] =~ />>|<</) {
 402                         if ($inpre) {
 403                             process_thing(\$q,"HTML");
 404                         }
 405                         else {
 406                             print HTML qq{\n</XMP>\n};
 407                             print HTML qq{<PRE>\n};
 408                             $inpre=1;
 409                             process_thing(\$q,"HTML");
 410                         }
 411                     }
 412                     1 while $q =~  s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e;
 413                     print HTML  $q,"\n";
 414                 }
 415                 last if $paras[$p+1] !~ /^\s/;
 416                 $p++;
 417             }
 418             print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n});
 419         }
 420         else {                             # other text
 421             @lines = split(/\n/,$paras[$p]);
 422             foreach $line (@lines) {
 423                 process_thing(\$line,"HTML");
 424                 $line =~ s/STRONG([^>])/STRONG>$1/;  # lame attempt to fix strong
 425                 print HTML qq{$line\n};
 426             }
 427         }
 428         print HTML qq{<p>};
 429     }
 430 }
 431
 432 sub process_thing{       # process a chunk, order important
 433     my($thing,$htype) = @_;
 434     pre_escapes($thing);
 435     find_refs($thing,$htype);
 436     post_escapes($thing);
 437 }
 438
 439 sub scan_thing{           # scan a chunk for later references
 440     my($cmd,$title,$pod) = @_;
 441     $_ = $title;
 442     s/\n$//;
 443     s/E<(.*?)>/&$1;/g;
 444     # remove any formatting information for the headers
 445     s/[SFCBI]<(.*?)>/$1/g;
 446     # the "don't format me" thing
 447     s/Z<>//g;
 448     if ($cmd eq "item") {
 449         /^\*/ and  return;      # skip bullets
 450         /^\d+\./ and  return;   # skip numbers
 451         s/(-[a-z]).*/$1/i;
 452         trim($_);
 453         return if defined $A->{$pod}->{"Items"}->{$_};
 454         $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_);
 455         $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_};
 456         Debug("items", "item $_");
 457         if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_
 458             && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1))
 459         {
 460             $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_};
 461             Debug("items", "item $1 REF TO $_");
 462         }
 463         if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) {
 464             my $pf = $1 . '//';
 465             $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s";
 466             if ($pf ne $_) {
 467                 $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_};
 468                 Debug("items", "item $pf REF TO $_");
 469             }
 470         }
 471     }
 472     elsif ($cmd =~ /^head[12]/) {
 473         return if defined($A->{$pod}->{"Headers"}->{$_});
 474         $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_);
 475         Debug("headers", "header $_");
 476     }
 477     else {
 478         warn "unrecognized header: $cmd" if $Debug;
 479     }
 480 }
 481
 482
 483 sub picrefs {
 484     my($char, $bigkey, $lilkey,$htype) = @_;
 485     my($key,$ref,$podname);
 486     for $podname ($pod,@inclusions) {
 487         for $ref ( "Items", "Headers" ) {
 488             if (defined $A->{$podname}->{$ref}->{$bigkey}) {
 489                 $value = $A->{$podname}->{$ref}->{$key = $bigkey};
 490                 Debug("subs", "bigkey is $bigkey, value is $value\n");
 491             }
 492             elsif (defined $A->{$podname}->{$ref}->{$lilkey}) {
 493                 $value = $A->{$podname}->{$ref}->{$key = $lilkey};
 494                 return "" if $lilkey eq '';
 495                 Debug("subs", "lilkey is $lilkey, value is $value\n");
 496             }
 497         }
 498         if (length($key)) {
 499                 ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/;
 500             if ($htype eq "NAME") {
 501                         return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
 502             }
 503             else {
 504                 1; # break here
 505                         return "\n$type$Podnames{$pod2}\#".$value."\">$bigkey<\/A>\n";
 506             }
 507         }
 508     }
 509     if ($char =~ /[IF]/) {
 510         return "<EM>$bigkey</EM>";
 511     } elsif ($char =~ /C/) {
 512                 return "<CODE>$bigkey</CODE>";
 513     } else {
 514                 if($bigkey =~ /STRONG/){
 515                 return $bigkey;
 516                 }
 517                 else {
 518                 return "<STRONG>$bigkey</STRONG>";
 519                 }
 520     }
 521 }
 522
 523 sub find_refs {
 524     my($thing,$htype) = @_;
 525     my($orig) = $$thing;
 526     # LREF: a manpage(3f) we don't know about
 527     for ($$thing) {
 528         #s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g;
 529         s@(\S+?://\S*[^.,;!?\s])@noremap(qq{<A HREF="$1">$1</A>})@ge;
 530         s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{<A HREF="MAILTO:$1">$1</A>}),gie;
 531         s/L<([^>]*)>/lrefs($1,$htype)/ge;
 532         s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
 533         s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
 534         s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge;
 535         s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge;
 536     }
 537     if ($$thing eq $orig && $htype eq "NAME") {
 538         $$thing = picrefs("I", $$thing, "", $htype);
 539     }
 540
 541 }
 542
 543 sub lrefs {
 544     my($page, $item) = split(m#/#, $_[0], 2);
 545     my($htype) = $_[1];
 546     my($podname);
 547     my($section) = $page =~ /\((.*)\)/;
 548     my $selfref;
 549     if ($page =~ /^[A-Z]/ && $item) {
 550         $selfref++;
 551         $item = "$page/$item";
 552         $page = $pod;
 553     }  elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) {
 554         $selfref++;
 555         $item = $page;
 556         $page = $pod;
 557     }
 558     $item =~ s/\(\)$//;
 559     if (!$item) {
 560         if (!defined $section && defined $Podnames{$page}) {
 561             return "\n$type$Podnames{$page}\">\nthe <EM>$page</EM> manpage<\/A>\n";
 562         } else {
 563             (warn "Bizarre entry $page/$item") if $Debug;
 564             return "the <EM>$_[0]</EM>  manpage\n";
 565         }
 566     }
 567
 568     if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
 569         $text = "<EM>$item</EM>";
 570         $ref = "Headers";
 571     } else {
 572         $text = "<EM>$item</EM>";
 573         $ref = "Items";
 574     }
 575     for $podname ($pod, @inclusions) {
 576         undef $value;
 577         if ($ref eq "Items") {
 578             if (defined($value = $A->{$podname}->{$ref}->{$item})) {
 579                         ($pod2,$num) = split(/_/,$value,2);  # break here
 580                         return (($pod eq $pod2) && ($htype eq "NAME"))
 581                         ? "\n<A NAME=\"".$value."\">\n$text</A>\n"
 582                         : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n";
 583         }
 584     }
 585         elsif ($ref eq "Headers") {
 586             if (defined($value = $A->{$podname}->{$ref}->{$item})) {
 587                 ($pod2,$num) = split(/_/,$value,2); # break here
 588                 return (($pod eq $pod2) && ($htype eq "NAME"))
 589                 ? "\n<A NAME=\"".$value."\">\n$text</A>\n"
 590                 : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n";
 591             }
 592         }
 593     }
 594     warn "No $ref reference for $item (@_)" if $Debug;
 595     return $text;
 596 }
 597
 598 sub varrefs {
 599     my ($var,$htype) = @_;
 600     for $podname ($pod,@inclusions) {
 601         if ($value = $A->{$podname}->{"Items"}->{$var}) {
 602             ($pod2,$num) = split(/_/,$value,2);
 603             Debug("vars", "way cool -- var ref on $var");
 604             return (($pod eq $pod2) && ($htype eq "NAME"))  # INHERIT $_, $pod
 605                 ? "\n<A NAME=\"".$value."\">\n$var</A>\n"
 606                 : "\n$type$Podnames{$pod2}\#".$value."\">$var<\/A>\n";
 607         }
 608     }
 609     Debug( "vars", "bummer, $var not a var");
 610     if($var =~ /STRONG/){
 611                 return $var;
 612     }
 613     else{
 614                 return "<STRONG>$var</STRONG>";
 615     }
 616 }
 617
 618 sub gensym {
 619     my ($podname, $key) = @_;
 620     $key =~ s/\s.*//;
 621     ($key = lc($key)) =~ tr/a-z/_/cs;
 622     my $name = "${podname}_${key}_0";
 623     $name =~ s/__/_/g;
 624     while ($sawsym{$name}++) {
 625         $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
 626     }
 627     return $name;
 628 }
 629
 630 sub pre_escapes {  # twiddle these, and stay up late  :-)
 631     my($thing) = @_;
 632     for ($$thing) {
 633                 s/([\200-\377])/noremap("&#".ord($1).";")/ge;
 634                 s/"(.*?)"/``$1''/gs;
 635                 s/&/noremap("&amp;")/ge;
 636                 s/<</noremap("&lt;&lt;")/eg;
 637                 s/([^ESIBLCF])</$1\&lt\;/g;
 638                 s/E<(\d+)>/\&#$1\;/g;                     # embedded numeric special
 639                 s/E<([^\/][^<>]*)>/\&$1\;/g;              # embedded special
 640     }
 641 }
 642 sub noremap {   # adding translator for hibit chars soon
 643     my $hide = $_[0];
 644     $hide =~ tr/\000-\177/\200-\377/;
 645     $hide;
 646 }
 647
 648
 649 sub post_escapes {
 650     my($thing) = @_;
 651     for ($$thing) {
 652         s/([^GM])>>/$1\&gt\;\&gt\;/g;
 653         s/([^D][^"MGA])>/$1\&gt\;/g;
 654         tr/\200-\377/\000-\177/;
 655     }
 656 }
 657
 658 sub Debug {
 659     my $level = shift;
 660     print STDERR @_,"\n" if $Debug{$level};
 661 }
 662
 663 sub dumptable  {
 664     my $t = shift;
 665     print STDERR "TABLE DUMP $t\n";
 666     foreach $k (sort keys %$t) {
 667         printf STDERR "%-20s <%s>\n", $t->{$k}, $k;
 668     }
 669 }
 670 sub trim {
 671     for (@_) {
 672         s/^\s+//;
 673         s/\s\n?$//;
 674     }
 675 }
 676 sub wanted {
 677     my $name = $name;
 678     if (-f $_) {
 679         if ($name =~ /\.p(m|od)$/){
 680             push(@modpods, $name) if ($name =~ /\.p(m|od)$/);
 681         }
 682     }
 683 }
 684 !NO!SUBS!
 685
 686 close OUT or die "Can't close $file: $!";
 687 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 688 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';