home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / pod / buildtoc next >
Text File  |  1996-01-29  |  3KB  |  203 lines
  1. use File::Find;
  2. use Cwd;
  3.  
  4. @pods = qw{
  5.         perl perldata perlsyn perlop perlre perlrun perlfunc perlvar
  6.         perlsub perlmod perlref perldsc perllol perlobj perltie
  7.         perlbot perldebug perldiag perlform perlipc perlsec perltrap
  8.         perlstyle perlxs perlxstut perlguts perlcall perlembed perlpod
  9.         perlbook 
  10.     };
  11. for (@pods) { s/$/.pod/ } 
  12.  
  13. $/ = '';
  14. @ARGV = @pods;
  15.  
  16. ($_= <<EOPOD2B) =~ s/^\t//gm && print;
  17.  
  18.     =head1 NAME
  19.  
  20.     perltoc - perl documentation table of contents
  21.  
  22.     =head1 DESCRIPTION
  23.  
  24.     This page provides a brief table of contents for the rest of the Perl 
  25.     documentation set.  It is meant to be be quickly scanned or grepped 
  26.     through to locate the proper section you're looking for.
  27.  
  28.     =head1 BASIC DOCUMENTATION
  29.  
  30. EOPOD2B
  31.  
  32. podset(@pods);
  33.  
  34. find \&getpods => qw(../lib ../ext);
  35. sub getpods {
  36.     if (/\.p(od|m)$/) { 
  37.     my $file = $File::Find::name;
  38.     die "tut $name" if $file =~ /TUT/;
  39.     unless (open (F, "< $_\0")) {
  40.         warn "bogus <$file>: $!";
  41.         system "ls", "-l", $file;
  42.     }  else { 
  43.         my $line;
  44.         while ($line = <F>) {
  45.         if ($line =~ /^=head1\s+NAME\b/) {
  46.             push @modpods, $file;
  47.             #warn "GOOD $file\n";
  48.             return;
  49.         } 
  50.         } 
  51.         warn "EVIL $file\n";
  52.     }
  53.     }
  54. }
  55.  
  56. die "no pods" unless @modpods;
  57.  
  58. for (@modpods) {
  59.     #($name) = /(\w+)\.p(m|od)$/;
  60.     $name = path2modname($_);
  61.     if ($name =~ /^[a-z]/) {
  62.     push @pragmata, $_;
  63.     } else {
  64.     if ($done{$name}++) {
  65.         # warn "already did $_\n";
  66.         next;
  67.     } 
  68.     push @modules, $_;
  69.     push @modname, $name;
  70.     } 
  71. } 
  72.  
  73. ($_= <<EOPOD2B) =~ s/^\t//gm && print;
  74.  
  75.  
  76.  
  77.     =head1 PRAGMA DOCUMENTATION
  78.  
  79. EOPOD2B
  80.  
  81. podset(sort @pragmata);
  82.  
  83. ($_= <<EOPOD2B) =~ s/^\t//gm && print;
  84.  
  85.  
  86.  
  87.     =head1 MODULE DOCUMENTATION
  88.  
  89. EOPOD2B
  90.  
  91. podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
  92.  
  93. ($_= <<EOPOD2B) =~ s/^\t//gm;
  94.  
  95.  
  96.     =head1 AUXILIARY DOCUMENTATION
  97.  
  98.     Here should be listed all the extra program's docs, but they
  99.     don't all have man pages yet:
  100.  
  101.     =item a2p
  102.  
  103.     =item s2p
  104.  
  105.     =item find2perl
  106.     
  107.     =item h2ph
  108.     
  109.     =item c2ph
  110.  
  111.     =item h2xs
  112.  
  113.     =item xsubpp
  114.  
  115.     =item pod2man 
  116.  
  117.     =item wrapsuid
  118.  
  119.  
  120.     =head1 AUTHOR
  121.  
  122.     Larry Wall E<lt><F<lwall\@sems.com>E<gt>, with the help of oodles 
  123.     of other folks.
  124.  
  125.  
  126. EOPOD2B
  127. print;
  128.  
  129. exit;
  130.  
  131. sub podset {
  132.     local @ARGV = @_;
  133.  
  134.     while(<>) {
  135.     if (s/^=head1 (NAME)\s*/=head2 /) {
  136.         $pod = path2modname($ARGV);
  137.         sub path2modname {
  138.         local $_ = shift;
  139.         s/\.p(m|od)$//;
  140.         s-.*?/(lib|ext)/--;
  141.         s-/-::-g;
  142.         s/(\w+)::\1/$1/;
  143.         return $_;
  144.         }
  145.         unitem(); unhead2();
  146.         print "\n \n\n=head2 ";
  147.         $_ = <>;
  148.         if ( /^\s*$pod\b/ ) {
  149.         print;
  150.         } else {
  151.         s/^/$pod, /;
  152.         print;
  153.         } 
  154.         next;
  155.     }
  156.     if (s/^=head1 (.*)/=item $1/) {
  157.         unitem(); unhead2();
  158.         print; nl(); next;
  159.     } 
  160.     if (s/^=head2 (.*)/=item $1/) {
  161.         unitem();
  162.         print "=over\n\n" unless $inhead2;
  163.         $inhead2 = 1;
  164.         print; nl(); next;
  165.  
  166.     } 
  167.     if (s/^=item (.*)\n/$1/) {
  168.         next if $pod eq 'perldiag';
  169.         s/^\s*\*\s*$// && next;
  170.         s/^\s*\*\s*//;
  171.         s/\s+$//;
  172.         next if /^[\d.]+$/;
  173.         next if $pod eq 'perlmod' && /^ftp:/;
  174.         ##print "=over\n\n" unless $initem;
  175.         print ", " if $initem;
  176.         $initem = 1;
  177.         s/\.$//;
  178.         print; next;
  179.     } 
  180.     } 
  181.  
  182. } 
  183.  
  184. sub unhead2 {
  185.     if ($inhead2) {
  186.     print "\n\n=back\n\n";
  187.     } 
  188.     $inhead2 = 0; 
  189.     $initem = 0;
  190. } 
  191.  
  192. sub unitem {
  193.     if ($initem) {
  194.     print "\n\n";
  195.     ##print "\n\n=back\n\n";
  196.     } 
  197.     $initem = 0;
  198. } 
  199.  
  200. sub nl {
  201.     print "\n";
  202. } 
  203.