home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_utl.zip / pod2texi.cmd < prev    next >
OS/2 REXX Batch file  |  1996-09-27  |  24KB  |  904 lines
  1. extproc perl -Sx 
  2. #!/usr/build/perl53/bin/perl
  3. #!/usr/local/bin/perl
  4. # changes pod to texinfo
  5. # you still have to insert a few TeXinfo directives to make it look
  6. # right ...
  7. # well, not any more (hopefully).
  8.  
  9. # parts stolen from pod2html (to get the perlpod listings, et al).
  10. # unfortunately, texinfo 1.1 can't jump to a certain location in a 
  11. # info page, so we can't do the kind of cool exactly-this-spot 
  12. # xrefs that html can ...
  13. # By Krishna Sethuraman (krishna@sgi.com)
  14.  
  15. # This was a real hack job -- I started this before I fully understood
  16. # anonymous references, so please feel free
  17. # to hack this apart.
  18.  
  19. # so we can get the locations for the library -> .pm -> module docs
  20.  
  21. use Config;
  22. use File::Find;
  23. sub intern_modnamehash;
  24. sub debug;
  25.  
  26. use vars (@envs);
  27. $modnode = 'Module List';
  28. $modinfofile = 'pm.info';
  29.  
  30. # Im sure not all these are needed, but cant hurt (I hope)
  31.  
  32. @libdirs = qw(archlibexp installarchlib installprivlib privlibexp archlib
  33.       installsitearch installsitelib privlib sitearch sitearchexp
  34.       sitelib sitelibexp);
  35.  
  36. @libdirs = qw(privlib archlib sitelib sitearch);
  37.  
  38. # previously, we used $Config{$libdir} in intern_modnamehash and the
  39. # foreach loop ... now we just use $libdir
  40. @libdirs = @INC;
  41.  
  42. # The beginning of the url for the anchors to the other sections.
  43. $nodeterm = "\c_";
  44. chop($wd=`pwd`);
  45. $type="<A HREF=\"file://localhost".$wd."/";
  46. $debug=0;
  47. $/ = "";
  48. $p=\%p;
  49. #@exclusions=qw(perldebug perlform perlobj perlstyle perltrap perlmod);
  50. $indent=0;
  51. opendir(DIR,".");
  52. @{$p->{"pods"}}=sort grep(/\.pod$/,readdir(DIR)); # sort so perl.pod is first
  53. closedir(DIR);
  54.  
  55. # put all modules into big hash of module name -> file
  56. # save current dir
  57. chop($curdir = `pwd`);
  58.  
  59. # for all library directories, go to that directory and find the .pod and .pm
  60. # files
  61. # 
  62.  
  63. debug("Module pod/pm discovery");
  64. chop($date = `date`);
  65.  
  66. libdir: foreach $libdir (@libdirs) {
  67.     chop($curdir = `pwd`);
  68.     chdir $libdir;
  69.     debug("Looking in $libdir:");
  70.     find (\&intern_modnamehash , '.');
  71.     chdir $curdir;
  72. }
  73.  
  74. chdir $curdir;
  75.  
  76. @modnames = sort keys %modnamehash;
  77.  
  78. # %modnamehash now maps module name -> file name.
  79.  
  80. # (1) LEARN the important stuff.
  81.  
  82. debug("Learning Pods");
  83.  
  84.  
  85. foreach $tmpod (@{$p->{"pods"}}, @modnames){
  86.  
  87. # if its a module, get the full filename
  88.  
  89.     if (defined($modnamehash{$tmpod})) {
  90.     $podfile = $modnamehash{$tmpod};
  91.     } else {
  92.     $podfile = $tmpod;
  93.     }
  94.  
  95.     ($pod=$tmpod)=~s/\.(pod|pm)$//;
  96.     $p->{"podnames"}->{$pod}=1;
  97.     next if grep(/$pod/,@exclusions);
  98.  
  99. # print them out semi-orderedly
  100.     
  101.     &echopod($pod);
  102.  
  103. # for each podfile
  104.  
  105.     open(POD,"<$podfile");
  106.     while(<POD>){
  107. # kill bold/italics
  108.     s/B<([^<>]*)>/$1/g;         # bold
  109.     s/I<([^<>]*)>/$1/g;         # bold
  110. # if = cmd
  111.         if (s/^=//) {
  112.         s/\n$//s;
  113.         s/\n/ /g;
  114.         ($cmd, $_) = split(' ', $_, 2);
  115. # if =item cmd
  116.          if ($cmd eq  "item") {
  117.         ($what,$rest)=split(' ', $_, 2);
  118. # what is now only the (-.) part (dash plus one character)
  119.         $what=~s#(-.).*#$1#;
  120.         $what=~s/\s*$//;
  121.  
  122.         next if defined $p->{"items"}->{$what};
  123. # put it in items subarray as podname_serialnumber(?)
  124.         $p->{"items"}->{$what} = $pod."_".$i++;
  125.         }
  126.         elsif($cmd =~ /^head/){
  127. # if =head cmd
  128.         $_=~s/\s*$//;
  129.         next if defined($p->{"headers"}->{$_});
  130. # put it in headers subarray as podname_serialnumber(?)
  131. # serial numbers, etc., look to be used as tags to indicate a position
  132. # in an html file.  No such luck in texinfo (sigh).
  133.         $p->{"headers"}->{$_} = $pod."_".$i++;
  134.         }
  135.     }
  136.     }
  137. }
  138.  
  139. # we can do all the above, just ignore the _ tagging stuff.  Maybe in the next
  140. # version of texinfo, we can ref a char. position in an info file.
  141.  
  142. # start big top-level files which include everything:
  143.  
  144. &start_big_files;
  145.  
  146. debug ("Reading Pods");
  147.  
  148.     $modulepod = 0;
  149.  
  150. # (2) READ each pod, write structuring information
  151. foreach $tmpod (@{$p->{"pods"}}, @modnames ){
  152.  
  153. # I dont think the table of contents is very useful in TeXinfo
  154. # someone may disagree
  155.     next if $tmpod eq 'perltoc.pod';
  156.  
  157.     if (defined($modnamehash{$tmpod})) {
  158.     # its a module file
  159.     $podfile = $modnamehash{$tmpod};
  160. # this next line gives us an index into @modnames
  161.     $modulepod++;
  162.     } else {
  163.     $podfile = $tmpod;
  164.     }
  165.  
  166.     open(POD,"<$podfile") || die "cant open $podfile";
  167.     ($pod=$tmpod)=~s/\.(pod|pm)$//;
  168.     open(TEXINFO,">$pod.texi");
  169.  
  170.     ($curn,$prevn,$nextn,$upn) = ();
  171.  
  172. # now translate :: to /, for tex/info
  173.  
  174.     ($curn = $pod) =~ s{::}{/}g;
  175.  
  176.     if (! $modulepod) {
  177.     
  178. # check if we have the lines array - if so, we can use it to
  179. # generate pod nodes and prev, next, etc. refs
  180. # the lines array comes from perl.pod, giving us the correct ordering
  181. # for the base pods
  182.  
  183.     if (@linesfornodes) {
  184.         $i=0;
  185.       podline: for (@linesfornodes) {
  186.         last podline if $pod eq $_;
  187.         $i++;
  188.         }
  189. # if we got to $#linesfornodes+1, we didnt find it.
  190.         unless ($i == $#linesfornodes+1) {
  191.         ($prevn, $curn, $nextn) = @linesfornodes[($i?$i-1:0),$i,$i+1];
  192.         $prevn = 'Top' if ($prevn eq $curn);
  193.         }
  194.     }
  195.  
  196. # specific to master perl node
  197.  
  198.     $upn = ($pod eq 'perl')?'(dir)' :'Top';
  199.  
  200.     $pod eq 'perl' and ($curn,$nextn) = ('Top','perldata');
  201.     $prevn eq 'perl' and $prevn = 'Top';
  202.  
  203.     $prevn ||= 'Top';
  204.     $nextn ||= 'Top';
  205.  
  206. } else {
  207. # module pod
  208. # structuring information - yech
  209. # just do a straight giant menu, if we can.  Calculate nodes similar to above.
  210.     
  211.     $idx = $modulepod -1;
  212.     ($prevn,$curn,$nextn) = ($idx?$modnames[$idx-1]:'',
  213.                  @modnames[$idx,$idx+1]);
  214.  
  215.     $prevn =~ s{::}{/}g;
  216.     $curn =~ s{::}{/}g;
  217.     $nextn =~ s{::}{/}g;
  218.  
  219.     $upn = $modnode;
  220. # I used to have these - well just have empty previous and next
  221. # to indicate beginning or end of a set of leaf nodes
  222. #    $prevn ||= $modnode;
  223. #    $nextn ||= $modnode;
  224.  
  225. }
  226.  
  227.     print STDOUT "for pod $pod, \@node $curn, $nextn, $prevn, $upn\n";
  228. #    print STDOUT "@linesfornodes\n";
  229.  
  230.     print TEXINFO <<_EOF_;
  231. \@node $curn, $nextn, $prevn, $upn
  232. _EOF_
  233.  
  234.  
  235.  
  236.     $cutting = 1;
  237.     $newenv = '';
  238.  
  239.     # (3) PROCESS each paragraph
  240. $gotshortdesc = 0;
  241. paragraph:    while (<POD>) {
  242.     if ($cutting) {
  243.         next unless /^=/;
  244.         $cutting = 0;
  245.     }
  246.     chop;
  247.     length || (print "\n") && next;
  248.  
  249.     # Translate verbatim paragraph
  250.  
  251. # greedy matching here will set $1 to all space before first nonspace
  252. # at beginning of string.  Since its unlikely [Ed: but it happens
  253. # sometimes, however, one common case is code examples with blank
  254. # newlines] anything after that in the same paragraph will be
  255. # outdented farther left than the first line, we can kill that much
  256. # whitespace from the beginning of each line.  we kill whitespace from
  257. # beginning of line for verbatim because example mode adds it back in.
  258.  
  259. # XXX - perhaps if we find 2 contiguous outdented paragraphs, we should put
  260. # them in the same @example environment
  261. # maybe the last line of the previous paragraph should be outdented
  262. # the same as the first line of the next.
  263.  
  264.     if (($space) = /^(\s+)/) { 
  265.         &pre_escapes($_);
  266.         @lines = split(/\n/);
  267.         if($lines[0]=~/^\s+(\w*)\t(.*)/){  # maybe a menu
  268.         ($key,$rest)=($1,$2);
  269.         if(defined($p->{"podnames"}->{$key})){ # yup, a menu
  270.             # process menu here. if not a menu, its an example
  271.             # or Its a menu.  Save it for end of node.
  272.             print TEXINFO "\n\@menu\n";
  273.             for (@lines) {
  274.             m/^\s+(\w*)\t(.*)/;
  275.             print TEXINFO "* $1:: $2\n";
  276.             }
  277.  
  278. # special case, top perl node
  279.             if ($key eq 'perl') {
  280.             print TEXINFO <<"EOF";
  281.  
  282. * Module List:($modinfofile)$modnode. Got your modules, right here
  283. * Function Index:: Perl functions and operators
  284. * Predefined Variable Index:: Perl predefined variables
  285. * Diagnostics Index:: Perl diagnostic messages
  286.  
  287.  
  288. EOF
  289. }
  290.  
  291.             print TEXINFO "\@end menu\n\n";
  292. # this next bit we will do by hand for now...
  293. #            for (@lines) {
  294. #            m/^\s+(\w*)\t(.*)/;
  295. #            print TEXINFO "\@include $1.texinfo\n";
  296. #            }
  297.             @linesfornodes = @lines;
  298.             map(s/^\s+(\w*)\t(.*)/$1/,@linesfornodes);
  299.             # done with menu paragraph, next paragraph
  300.             next;
  301.         }
  302.         # not a menu, process it as example
  303.         }
  304.         s/^$space//mg;
  305.         print TEXINFO "\@example\n", $_, "\@end example\n\n";
  306.         next;
  307.     }
  308.  
  309.     $_ = &all_escapes($_,$pod);
  310.  
  311.     if (s/^=//) {
  312.         s/\n$//s;
  313.         s/\n/ /g;
  314.         ($cmd, $_) = split(' ', $_, 2);
  315.         if ($cmd eq 'cut') {
  316.         $cutting = 1;
  317.         }
  318.         elsif ($cmd eq 'head1') {
  319.  
  320. # if NAME, slurp in the next paragraph and use it (instead of 'NAME') as
  321. # a chapter title
  322.  
  323. # have to run it through the escapes ourselves
  324.         if (/^\s*NAME/) {
  325.             $gotshortdesc = 1;
  326.             $podorigshortdesc = <POD>;
  327.             $podshortdesc = $podorigshortdesc;
  328.             # trim actual pod name (should we?)
  329.             $podshortdesc =~ s/^[^---]+-+\s*//;
  330.             $podshortdesc = &all_escapes($podshortdesc, $pod);
  331.             # if the name is multiline, change all but the
  332.             # last to a space
  333.             $podshortdesc =~ s/\n(.+)/ $1/g;
  334.  
  335.             print TEXINFO qq|\@unnumbered $podshortdesc\n|;
  336.  
  337.             # include a menu entry for module pods
  338.             
  339.             chop($nonewline = $podshortdesc);
  340.  
  341.             $modulepod && print MODLISTTEXI
  342.                           qq|* $ {curn}:: $nonewline|;
  343.         }
  344.  
  345.         # print out the heading info anyway
  346.  
  347.         &closeenvs;
  348.         print TEXINFO qq|\@unnumberedsec $_\n\n|;
  349.         
  350.         /^\s*NAME/ && ($_ = $podorigshortdesc,redo paragraph);
  351.  
  352.         }
  353.         elsif ($cmd eq 'head2') {
  354.  
  355.         # if @env has an entry, we had =over or =items
  356.         # but no =back - close it here
  357.  
  358.         &closeenvs;
  359.         print TEXINFO qq|\@unnumberedsubsec $_\n\n|;
  360.         }
  361.         elsif ($cmd eq 'item') {
  362.         ($what,$rest)=split(' ', $_, 2);
  363.         $what=~s/\s*$//;
  364.  
  365. # various cases - single star, star with stuff after it
  366. # number, or something else
  367.  
  368. # people sometimes forget to put a leading =over.
  369. # if =item at top level (empty array), assume =over
  370.  
  371.         if ($what =~ /[*]/) { # if a single star, axe it
  372.         # texinfo itemize can put in its own star.
  373.             $_ = $rest;
  374.  
  375.             if (scalar(@envs) == 0 or $newenv) {
  376.             $newenv = 0,
  377.             unshift (@envs, 'itemize'),
  378.             print TEXINFO '@itemize @bullet', "\n";
  379.              };
  380.             
  381. # if a single star, its a bulleted list with paragraphs - 
  382. # need a newline before paragraphs if theres anything
  383. # left on that line.  Else, if no star,
  384. # its probably going to be a table - no newlines before paragraph
  385.  
  386. # sometimes its not a table (but more so than otherwise)
  387. # tables do the right thing, @itemize items run together
  388. # if no newline - no good heuristic if @item foo because
  389. # dont know if table or itemize ahead of time
  390.  
  391.             $next_para=1 if $rest;
  392.  
  393. # if digits, get rid of them ...
  394.         } elsif ($what =~ /^\d+[.]?/) { 
  395.  
  396.     # texinfo enumerate can put in its own numbers
  397.             $_ = $rest;
  398.  
  399.             if (scalar(@envs) == 0 or $newenv) {
  400.             $newenv = 0,
  401.             unshift (@envs, 'enumerate'),
  402.             print TEXINFO '@enumerate', "\n";
  403.             }
  404.  
  405. # if a single star, its a bulleted list with paragraphs - 
  406. # need a newline before paragraphs.  Else, if digits
  407. # its enumerated - no newlines before paragraph
  408.  
  409.             $next_para=0;
  410.         } else {
  411.  
  412.             if (scalar(@envs) == 0 or $newenv) {
  413.             $newenv = 0,
  414.             unshift (@envs, 'table'),
  415.             print TEXINFO '@table @asis', "\n";
  416.             }
  417.         }
  418.  
  419.         # only if we have starred items do we want to really
  420.         # have separate items - else, two items
  421.         # in a row is likely an itemx
  422.         # candidate.  We will see how this goes
  423.  
  424. # previously we only wanted itemx if they had the first word
  425. # in common (write, write FILEHANDLE, etc.)
  426. #        if($justdid ne $what && $what =~ /[*]/){}
  427.  
  428. # if theres text on the same line as an item in enumerate,
  429. # emacs texinfo processing will complain
  430.  
  431.         if(! $justdid || $what =~ /([*])|(\d+[.]?)/){
  432.             if ($rest && $envs[0] eq 'enumerate') {
  433.             print TEXINFO "\@item \n$_\n";
  434.             } else {
  435.             print TEXINFO "\@item $_\n";
  436.             }
  437.             ($pod =~ /perldiag/) && print TEXINFO "\@dgindex $_\n";
  438.             ($pod =~ /perlfunc/) && print TEXINFO "\@findex $_\n";
  439.             ($pod =~ /perlvar/) && print TEXINFO "\@vindex $_\n";
  440.             $justdid=$what;
  441.         } else {
  442.             print TEXINFO qq{\@itemx $_\n};
  443.         }
  444.         }
  445.         elsif ($cmd eq 'over') {
  446.         # indicate start of a new itemization
  447.         $newenv = 1;
  448.         $justdid = '';
  449.         }
  450.         elsif ($cmd eq 'back') {
  451.         # if @env is empty, we had an =over but no =items
  452.         # bad form, but we can silently continue
  453.         
  454.         print TEXINFO '@end ', shift(@envs), "\n" if @envs;
  455.         }
  456.         else {
  457.         warn "Unrecognized directive: $cmd\n";
  458.         }
  459.     }
  460.     else {
  461. # not a perl command, so dont try to compare vs. the last item for itemxing
  462. # upcoming paragraphs
  463.         $justdid = ''; 
  464.         
  465.         length || next;
  466. # argh - in itemize, it sucks the whole thing up to the next line
  467. # in table, it doesn't
  468. # we don't know whether to do table or itemize
  469.  
  470.         $next_para && print TEXINFO "\n";
  471. #        $next_para && (print TEXINFO  qq{<dd>\n});
  472.         print TEXINFO  "$_\n";
  473. #        $next_para && (print  TEXINFO qq{</dd>\n<p>\n}) && ($next_para=0);
  474.         $next_para = 0;
  475.     }
  476.     }
  477.  
  478. # clean up envs that ran off the end of the document
  479.  
  480.     &closeenvs;
  481.  
  482. # write to our big file of include statements
  483. # need 2 newlines cuz of weirdness (bug?) in texinfo processing
  484.     if (! $modulepod) {
  485.     print BIGTEXI "\@include $nextn.texi\n\n" if ($nextn ne 'Top');
  486.     } else {
  487.     print BIGMODTEXI "\@include $modnames[$idx].texi\n\n" 
  488.     }
  489. # if no short description, still create menu entry
  490.     if ($modulepod && ! $gotshortdesc) {
  491.     print MODLISTTEXI "* ${curn}:: MISSING SHORT DESCRIPTION\n";
  492.     }
  493. }
  494.  
  495. # finish our big files
  496.  
  497. &finish_big_files;
  498.  
  499. #########################################################################
  500.  
  501. sub all_escapes {
  502.     local($_,$pod) = @_;
  503.     &pre_escapes($_);
  504. # bug in texinfo - @@ at beginning of line gets hosed
  505. # only need to fix if not =over paragraph - those work ok
  506.     s/\n@@/\n @@/g;
  507.     $_ = &Do_refs($_,$pod);
  508.     
  509.     s/Z<>//g; #  what to do with this?
  510. #    s/E<lt>/</g;
  511. #    s/E<gt>/>/g;
  512.  
  513.     s/Less_Than_Special_Sequence/</g;
  514.     s/Greater_Than_Special_Sequence/>/g;
  515.  
  516.     return $_;
  517.  
  518.     }
  519.  
  520. sub pre_escapes {
  521.     local($_) = @_;
  522.     s/E<lt>/Less_Than_Special_Sequence/g;
  523.     s/E<gt>/Greater_Than_Special_Sequence/g;
  524.     s/[\@{}\`\']/\@$&/g;
  525. #    s/C<E<lt>E<lt>>/\@code{<<}/g;
  526. #    s/C<-E<gt>>/\@code{->}/g;
  527.     $_[0] = $_;
  528. }
  529.  
  530. sub post_escapes{
  531.     local($_) = @_;
  532. #    s/>>/\>\;\>\;/g;
  533. #    s/([^"AIB])>/$1\>\;/g;
  534.     $_[0] = $_;
  535. }
  536.  
  537. sub Do_refs{
  538. local($para,$pod)=@_;
  539.  
  540. # quick hack, but may slow things down considerably
  541. # since tags are nestable, we must keep going until we cant see
  542. # any more X< (this means we must make sure E<lt> doesnt get
  543. # translated to a < prior to a call to this function, to be safe).  Done
  544. # in pre_escapes.
  545.  
  546. # this will *HANG* if tags are mis-nested!!!!
  547.  
  548. $iter = 0;
  549. pass: while ($para =~ /[LCIBSFZ]</) {
  550.     if ($iter++ == 15) { 
  551.     print  <<EOF;
  552. Too many iterations on this paragraph:
  553.  
  554. $para
  555.  
  556. Most likely an unescaped < or > (use E<lt> or E<gt> instead) or one
  557. of those is missing its mate.
  558.  
  559. EOF
  560.     last pass;
  561.     }
  562. foreach $char (qw(L C I B S F Z)){
  563.     next unless $para =~ /($char<[^<>]*>)/;
  564. # @ar = split paragraph, making array elements out of 
  565. # the current char<foo> as well as regular text
  566.     local(@ar) = split(/($char<[^<>]*>)/,$para);
  567.     local($this,$key,$num,$sec,$also);
  568. # for all @ar elements,
  569.     for($this=0;$this<=$#ar;$this++){
  570. # only handle the current chars char<foo> thingies
  571.         next unless $ar[$this] =~ /$char<([^<>]*)>/;
  572.  
  573. # if just single foo, $key = foo.  Else if foo/bar, $key = foo, 
  574. # $sec = bar.
  575.     $key=$1;
  576.     ($chkkey,$sec) = ($key =~ m|^([^/]+)(?:/([^/]+))?|);
  577. # XXX if chkkey was '' but there was a slash, use the 'in this node' case
  578. # if the key matches a podname, put in a ref to the pod
  579.     if((defined($p->{"podnames"}->{$chkkey})) && ($char eq "L")){
  580.  
  581.         $also = "\@samp{$sec}, " if $sec ;
  582. #        $ar[$this] = "${also}\@xref{$chkkey,\u$chkkey,,$chkkey.info},";
  583.  
  584. # specify the other info file, if necessary:
  585.  
  586.         $shortname = $chkkey;
  587.  
  588.         if (!defined $modnamehash{$pod} &&
  589.         defined $modnamehash{$chkkey}) {
  590.         $chkkey = "($modinfofile)$chkkey";
  591.         } elsif (defined $modnamehash{$pod} &&
  592.              !defined $modnamehash{$chkkey}) {
  593.         $chkkey = "(perl.info)$chkkey";
  594.         }
  595.  
  596. # as stated above, keys to podnames have ::, which we must translate
  597. # to /
  598.         $shortname =~ s{::}{/}g;
  599.         $chkkey =~ s{::}{/}g;
  600.  
  601.         $ar[$this] = "${also}\@xref{$chkkey,\u$shortname},";
  602.         # *note arg2: (arg3) arg1
  603. # otherwise, if char is still "L", then key didnt match a podname
  604. # and therefore is a section on the current manpage
  605.     } 
  606.     elsif ($char eq "L") {
  607.     $ar[$this] = "\@samp{$chkkey} in this node";
  608.     }
  609.  
  610. # if the key matches an item, put in a ref to the item def.
  611. # ignore this for now
  612.     elsif(defined($p->{"items"}->{$key})){
  613.         ($pod2,$num)=split(/_/,$p->{"items"}->{$key},2);
  614.         $ar[$this] = (($pod2 eq $pod) && ($para=~/^\=item/)) ?
  615. #        "\n<A NAME=\"".$p->{"items"}->{$key}."\">\n$key</A>\n"
  616.             $key:$key
  617. #        "\n$type$pod2.html\#".$p->{"items"}->{$key}."\">$key<\/A>\n"
  618.             ;
  619.         }
  620. # if the key matches a header, put in a ref to the header def.
  621. #ignore this to start with
  622.     elsif(defined($p->{"headers"}->{$key})){
  623.         ($pod2,$num)=split(/_/,$p->{"headers"}->{$key},2);
  624.         $ar[$this] = (($pod eq $pod2) && ($para=~/^\=head/)) ? 
  625. #        "\n<A NAME=\"".$p->{"headers"}->{$key}."\">\n$key</A>\n"
  626.         $key:$key
  627. #        "\n$type$pod2.html\#".$p->{"headers"}->{$key}."\">$key<\/A>\n"
  628.             ;
  629.  
  630. # if its an item or header, formatting will be lost because
  631. # of the else construct here
  632.  
  633.     }
  634.     else{
  635.         (warn "No \"=item\" or \"=head\" reference for $ar[$this] in $pod\n") if $debug;
  636.         if ($char eq "L"){
  637.         $ar[$this]=$key;
  638.         }
  639.         elsif($char eq "I"){
  640.         $ar[$this]="\@emph{$key}";
  641.         }
  642.         elsif($char eq "B"){
  643.         $ar[$this]="\@strong{$key}";
  644.         }
  645.         elsif($char eq "S"){
  646.         $ar[$this]="\@w{$key}";
  647.         }
  648.         elsif($char eq "C"){
  649.         $ar[$this]="\@code{$key}";
  650.         }
  651.         elsif($char eq "F"){
  652.         $ar[$this]="\@file{$key}";
  653.         }
  654.     }
  655.     }
  656.     $para=join('',@ar);
  657. }
  658. }
  659. $para;
  660. }
  661.  
  662. sub intern_modnamehash {
  663.  
  664. # File::Find is pretty screwy.
  665. # I think we can't modify $_ or File::Find can screw up
  666.  
  667.     my $shortpath;
  668.     my $thename;
  669.     
  670. # this could be a problem - if we search $sitelibdir,
  671. # its usually a subdir of $libdir, in which case we don't want it
  672. # to think 'site_perl' is a class name.
  673.  
  674. # XXX - may be doing toplevel modules incorrectly in the above case
  675. # is 'name' just the filename?  thats not good ....
  676.     $thename = $File::Find::name;
  677.     $shortpath = $thename;
  678.  
  679. # kill leading './'
  680.  
  681.     $thename =~ s{^[.]/}{};
  682.  
  683. # XXX - take the current $libdir (/foo/bar) 
  684. # and see if the file were testing (/foo/bar/site_perl/Plugh/Blah.pm) is
  685. # in any *other*, deeper subdir in @INC
  686. # (/foo/bar/site_perl) - if so, skip this entry, cuz the deeper 
  687. # subdir will catch it properly (Plugh::Blah)
  688.  
  689. # for other libraries that are proper subdirs of the current libdir
  690.     foreach $otherlibrary (grep /^$libdir.+/, @INC) {
  691.  
  692. # if the other library is part of the current files path, skip it
  693. # because it will be caught when the other library is used
  694.  
  695.     if ("$libdir/$thename" =~ /^$otherlibrary/) {
  696.         print ".";
  697. #        print "Skipping $thename\n";
  698. #        print "cuz $otherlibrary caught/will catch it\n";
  699.         return;
  700.     }
  701.     }
  702.  
  703. # exclude base pods - perlfoo.pod
  704.     ($thename =~ m/perl.*[.]pod/) && return;
  705.  
  706. # for each file entry, kill trailing '.(pod|pm)'
  707.     (-f "$libdir/$thename") &&
  708.     ($thename =~ s{^(.*)[.](pod|pm)$ }{$1}x) or return;
  709.  
  710. # '.pod' files nonhierarchical - keep only last component as module name.
  711. # well, hierarchical in Tk ... keep it hierarchical for now
  712.  
  713. #    if ($2 eq 'pod') {$thename =~ s{.*/([^/]+)}{$1}; }
  714.     
  715. # translate to module syntax
  716.  
  717.     $thename =~ s{/}{::}g;
  718.  
  719. # if its already in the hash, skip it.  We're following @INC order,
  720. # which means if its found in a earlier @INC directory, it will
  721. # be the one thats `use'd.  So rather than overwriting an earlier
  722. # @INC entry with a newer one, we skip the newer one if the earlier
  723. # one exists (or, we could do the foreach on (reverse @INC) instead
  724. # of (@INC)).
  725.  
  726.     
  727.     if (defined $modnamehash{$thename}) {
  728. #    print "already found $thename\n";
  729. #    print "in $modnamehash{$thename}\n";
  730.     return
  731.     };
  732.  
  733.     $modnamehash{$thename} = "$libdir/$shortpath";
  734.  
  735. # If this is a .pm file, is there actually any documentation in it?    
  736.     
  737.     if ($modnamehash{$thename} =~ /[.]pm$/) {
  738.         open(MODULE, "$modnamehash{$thename}");
  739.       line: while ($theline = <MODULE>) {
  740.         $theline =~ /^=head\d/ && last line;
  741.         eof(MODULE) && delete $modnamehash{$thename};
  742.         }
  743.     }
  744.  
  745.     echopod($thename) if $modnamehash{$thename};
  746. }
  747.  
  748. sub wait{1;}
  749.  
  750. sub echopod {
  751.  
  752.     $savenew = $_[0];
  753.  
  754. # if neither has a ::, same line
  755.  
  756.     if ($oldpod !~ /::/ && $_[0] !~ /::/) {
  757.  
  758. # if old one has a ::, different lines
  759.  
  760.     } elsif ($oldpod =~ /::/ && $_[0] !~ /::/) {
  761.  
  762.     print "\n";
  763.  
  764.     } elsif ($oldpod !~ /::/ && $_[0] =~ /::/) {
  765.  
  766. # if its the new one that has ::, start a header line
  767.  
  768.     ($new) = ($_[0] =~ /^([^:]+)::/);
  769.     print "\n${new} modules: ";
  770.     $_[0] = $';
  771.  
  772.     } else {
  773.  
  774. # if both have ::, if stuff before first :: is different, newline
  775. # if stuff before is the same, trim it before printing (same line)
  776.  
  777.     ($old) = ($oldpod =~ /^([^:]+)::/);
  778.     ($new) = ($_[0] =~ /^([^:]+)::/);
  779.     if ($old eq $new) {
  780.         # kill leading stuff
  781.         $_[0] = $';
  782.     } else {
  783.         print "\n${new} modules: ";
  784.         $_[0] = $';
  785.     }
  786.     } 
  787.  
  788.     $oldpod = $savenew;
  789.     
  790.     print $_[0], " ";
  791.  
  792. }
  793.  
  794.  
  795. sub start_big_files {
  796.  
  797. open(BIGTEXI,">bigperl.texi"); 
  798.     print BIGTEXI <<'_EOF_' ;
  799. \input texinfo.tex
  800. @comment %**start of header
  801. @setfilename perl.info
  802. settitle perl
  803. @c footnotestyle separate
  804. @c paragraphindent 2
  805. @smallbook
  806. @comment %**end of header
  807. @defindex dg
  808.  
  809. @include perl.texi
  810.  
  811. _EOF_
  812.  
  813. open(BIGMODTEXI,">bigpm.texi"); 
  814.     print BIGMODTEXI <<'_EOF_', "\@setfilename $modinfofile\n", <<'_MOREEOF_';
  815. \input texinfo.tex
  816. @comment %**start of header
  817. _EOF_
  818. @settitle Big Module file
  819. @c footnotestyle separate
  820. @c paragraphindent 2
  821. @smallbook
  822. @comment %**end of header
  823.  
  824. @comment Giant module file.
  825.  
  826. @include modlist.texi
  827.  
  828. _MOREEOF_
  829.  
  830. open(MODLISTTEXI,">modlist.texi"); 
  831.     print MODLISTTEXI <<"_EOF_" ;
  832. \@node $modnode, (perl.info)Function Index, ,(perl.info)Top
  833. \@unnumbered Module List
  834.  
  835. This is it!  The list of the installed (documented) modules on
  836. $ENV{'HOST'}, as of $date.
  837.  
  838. Texinfo source for this file was generated by $ENV{'USER'} running
  839. pod2texi.pl.  This info file itself was created \@today{}.
  840.  
  841. \@menu
  842.  
  843. _EOF_
  844.  
  845. }
  846.  
  847. sub finish_big_files {
  848. print BIGTEXI << 'EOF';
  849. @include indices.texi
  850.  
  851. @summarycontents
  852. @contents
  853.  
  854. @bye
  855. EOF
  856.  
  857. print BIGMODTEXI << 'EOF';
  858. @summarycontents
  859. @contents
  860.  
  861. @bye
  862. EOF
  863.  
  864. print MODLISTTEXI << 'EOF';
  865. @end menu
  866. EOF
  867.  
  868. # make an index file
  869.  
  870. open(INDICES,">indices.texi");
  871. print INDICES <<'EOF';
  872.  
  873. @node Function Index, Predefined Variable Index, , Top
  874. @comment    node-name,         next,       previous, up
  875. @unnumbered Function Index
  876.  
  877. @printindex fn
  878.  
  879. @node Predefined Variable Index, Diagnostics Index, Function Index, Top
  880. @comment    node-name,         next,       previous, up
  881. @unnumbered Predefined Variable Index
  882.  
  883. @printindex vr
  884.  
  885. @node     Diagnostics Index,  , Predefined Variable Index, Top
  886. @comment      node-name, next,       previous, up
  887. @unnumbered Diagnostics Index
  888.  
  889. @printindex dg
  890.  
  891. EOF
  892. }
  893.  
  894. sub debug {
  895. print "\n", '=' x 79, "\n$_[0]\n", '=' x 79 , "\n";
  896. }
  897.  
  898. sub closeenvs {
  899.     for (@envs) {
  900.     print TEXINFO "\@end $_\n";
  901.     }
  902.     @envs = ();
  903. }
  904.