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. ($_= <<EOPOD2B) =~ s/^\t//gm && print;
  73.  
  74.  
  75.  
  76.     =head1 PRAGMA DOCUMENTATION
  77.  
  78. EOPOD2B
  79.  
  80. podset(sort @pragmata);
  81.  
  82. ($_= <<EOPOD2B) =~ s/^\t//gm && print;
  83.  
  84.  
  85.  
  86.     =head1 MODULE DOCUMENTATION
  87.  
  88. EOPOD2B
  89.  
  90. podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
  91.  
  92. ($_= <<EOPOD2B) =~ s/^\t//gm;
  93.  
  94.  
  95.     =head1 AUXILIARY DOCUMENTATION
  96.  
  97.     Here should be listed all the extra program's docs, but they
  98.     don't all have man pages yet:
  99.  
  100.     =item a2p
  101.  
  102.     =item s2p
  103.  
  104.     =item find2perl
  105.     
  106.     =item h2ph
  107.     
  108.     =item c2ph
  109.  
  110.     =item h2xs
  111.  
  112.     =item xsubpp
  113.  
  114.     =item pod2man 
  115.  
  116.     =item wrapsuid
  117.  
  118.  
  119.     =head1 AUTHOR
  120.  
  121.     Larry Wall E<lt><F<lwall\@sems.com>E<gt>, with the help of oodles 
  122.     of other folks.
  123.  
  124.  
  125. EOPOD2B
  126. print;
  127.  
  128. exit;
  129.  
  130. sub podset {
  131.     local @ARGV = @_;
  132.  
  133.     while(<>) {
  134.     if (s/^=head1 (NAME)\s*/=head2 /) {
  135.         $pod = path2modname($ARGV);
  136.         sub path2modname {
  137.         local $_ = shift;
  138.         s/\.p(m|od)$//;
  139.         s-.*?/(lib|ext)/--;
  140.         s-/-::-g;
  141.         s/(\w+)::\1/$1/;
  142.         return $_;
  143.         }
  144.         unitem(); unhead2();
  145.         print "\n \n\n=head2 ";
  146.         $_ = <>;
  147.         if ( /^\s*$pod\b/ ) {
  148.         print;
  149.         } else {
  150.         s/^/$pod, /;
  151.         print;
  152.         } 
  153.         next;
  154.     }
  155.     if (s/^=head1 (.*)/=item $1/) {
  156.         unitem(); unhead2();
  157.         print; nl(); next;
  158.     } 
  159.     if (s/^=head2 (.*)/=item $1/) {
  160.         unitem();
  161.         print "=over\n\n" unless $inhead2;
  162.         $inhead2 = 1;
  163.         print; nl(); next;
  164.  
  165.     } 
  166.     if (s/^=item (.*)\n/$1/) {
  167.         next if $pod eq 'perldiag';
  168.         s/^\s*\*\s*$// && next;
  169.         s/^\s*\*\s*//;
  170.         s/\s+$//;
  171.         next if /^[\d.]+$/;
  172.         next if $pod eq 'perlmod' && /^ftp:/;
  173.         ##print "=over\n\n" unless $initem;
  174.         print ", " if $initem;
  175.         $initem = 1;
  176.         s/\.$//;
  177.         print; next;
  178.     } 
  179.     } 
  180.  
  181.  
  182. sub unhead2 {
  183.     if ($inhead2) {
  184.     print "\n\n=back\n\n";
  185.     } 
  186.     $inhead2 = 0; 
  187.     $initem = 0;
  188.  
  189. sub unitem {
  190.     if ($initem) {
  191.     print "\n\n";
  192.     ##print "\n\n=back\n\n";
  193.     } 
  194.     $initem = 0;
  195.  
  196. sub nl {
  197.     print "\n";
  198.