home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-src.tgz / tar.out / fsf / perl / pod / buildtoc next >
Text File  |  1996-09-28  |  4KB  |  208 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 $tmp;
  38.     # Skip .pm files that have corresponding .pod files, and Functions.pm.
  39.     return if (($tmp = $_) =~ s/\.pm$/.pod/ && -f $tmp);
  40.     return if ($_ eq '../lib/Pod/Functions.pm');####Used only by pod itself
  41.  
  42.     my $file = $File::Find::name;
  43.     die "tut $name" if $file =~ /TUT/;
  44.     unless (open (F, "< $_\0")) {
  45.         warn "bogus <$file>: $!";
  46.         system "ls", "-l", $file;
  47.     }  else { 
  48.         my $line;
  49.         while ($line = <F>) {
  50.         if ($line =~ /^=head1\s+NAME\b/) {
  51.             push @modpods, $file;
  52.             #warn "GOOD $file\n";
  53.             return;
  54.         } 
  55.         } 
  56.         warn "EVIL $file\n";
  57.     }
  58.     }
  59. }
  60.  
  61. die "no pods" unless @modpods;
  62.  
  63. for (@modpods) {
  64.     #($name) = /(\w+)\.p(m|od)$/;
  65.     $name = path2modname($_);
  66.     if ($name =~ /^[a-z]/) {
  67.     push @pragmata, $_;
  68.     } else {
  69.     if ($done{$name}++) {
  70.         # warn "already did $_\n";
  71.         next;
  72.     } 
  73.     push @modules, $_;
  74.     push @modname, $name;
  75.     } 
  76. } 
  77.  
  78. ($_= <<EOPOD2B) =~ s/^\t//gm && print;
  79.  
  80.  
  81.  
  82.     =head1 PRAGMA DOCUMENTATION
  83.  
  84. EOPOD2B
  85.  
  86. podset(sort @pragmata);
  87.  
  88. ($_= <<EOPOD2B) =~ s/^\t//gm && print;
  89.  
  90.  
  91.  
  92.     =head1 MODULE DOCUMENTATION
  93.  
  94. EOPOD2B
  95.  
  96. podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
  97.  
  98. ($_= <<EOPOD2B) =~ s/^\t//gm;
  99.  
  100.  
  101.     =head1 AUXILIARY DOCUMENTATION
  102.  
  103.     Here should be listed all the extra program's docs, but they
  104.     don't all have man pages yet:
  105.  
  106.     =item a2p
  107.  
  108.     =item s2p
  109.  
  110.     =item find2perl
  111.     
  112.     =item h2ph
  113.     
  114.     =item c2ph
  115.  
  116.     =item h2xs
  117.  
  118.     =item xsubpp
  119.  
  120.     =item pod2man 
  121.  
  122.     =item wrapsuid
  123.  
  124.  
  125.     =head1 AUTHOR
  126.  
  127.     Larry Wall E<lt>F<lwall\@sems.com>E<gt>, with the help of oodles 
  128.     of other folks.
  129.  
  130.  
  131. EOPOD2B
  132. print;
  133.  
  134. exit;
  135.  
  136. sub podset {
  137.     local @ARGV = @_;
  138.  
  139.     while(<>) {
  140.     if (s/^=head1 (NAME)\s*/=head2 /) {
  141.         $pod = path2modname($ARGV);
  142.         sub path2modname {
  143.         local $_ = shift;
  144.         s/\.p(m|od)$//;
  145.         s-.*?/(lib|ext)/--;
  146.         s-/-::-g;
  147.         s/(\w+)::\1/$1/;
  148.         return $_;
  149.         }
  150.         unitem(); unhead2();
  151.         print "\n \n\n=head2 ";
  152.         $_ = <>;
  153.         if ( /^\s*$pod\b/ ) {
  154.         print;
  155.         } else {
  156.         s/^/$pod, /;
  157.         print;
  158.         } 
  159.         next;
  160.     }
  161.     if (s/^=head1 (.*)/=item $1/) {
  162.         unitem(); unhead2();
  163.         print; nl(); next;
  164.     } 
  165.     if (s/^=head2 (.*)/=item $1/) {
  166.         unitem();
  167.         print "=over\n\n" unless $inhead2;
  168.         $inhead2 = 1;
  169.         print; nl(); next;
  170.  
  171.     } 
  172.     if (s/^=item (.*)\n/$1/) {
  173.         next if $pod eq 'perldiag';
  174.         s/^\s*\*\s*$// && next;
  175.         s/^\s*\*\s*//;
  176.         s/\s+$//;
  177.         next if /^[\d.]+$/;
  178.         next if $pod eq 'perlmod' && /^ftp:/;
  179.         ##print "=over\n\n" unless $initem;
  180.         print ", " if $initem;
  181.         $initem = 1;
  182.         s/\.$//;
  183.         print; next;
  184.     } 
  185.     } 
  186.  
  187. } 
  188.  
  189. sub unhead2 {
  190.     if ($inhead2) {
  191.     print "\n\n=back\n\n";
  192.     } 
  193.     $inhead2 = 0; 
  194.     $initem = 0;
  195. } 
  196.  
  197. sub unitem {
  198.     if ($initem) {
  199.     print "\n\n";
  200.     ##print "\n\n=back\n\n";
  201.     } 
  202.     $initem = 0;
  203. } 
  204.  
  205. sub nl {
  206.     print "\n";
  207. } 
  208.