pod/buildtoc

   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\@netlabs.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 }