pod/buildtoc

   1 use File::Find;
   2 use Cwd;
   3 use Text::Wrap;
   4
   5 sub output ($);
   6
   7 @pods = qw(
   8            perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
   9            perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata
  10            perlsyn perlop perlre perlrun perlfunc perlvar perlsub
  11            perlmod perlmodlib perlmodinstall perlfork perlform perllocale
  12            perlref perlreftut perldsc
  13            perllol perltoot perltootc perlobj perltie perlbot perlipc
  14            perldbmfilter perldebug
  15            perldiag perlsec perltrap perlport perlstyle perlpod perlbook
  16            perlembed perlapio perlxs perlxstut perlguts perlcall perlcompile
  17            perlhist
  18           );
  19
  20 for (@pods) { s/$/.pod/ }
  21
  22 $/ = '';
  23 @ARGV = @pods;
  24
  25 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
  26
  27         =head1 NAME
  28
  29         perltoc - perl documentation table of contents
  30
  31         =head1 DESCRIPTION
  32
  33         This page provides a brief table of contents for the rest of the Perl
  34         documentation set.  It is meant to be scanned quickly or grepped
  35         through to locate the proper section you're looking for.
  36
  37         =head1 BASIC DOCUMENTATION
  38
  39 EOPOD2B
  40 #' make emacs happy
  41
  42 podset(@pods);
  43
  44 find \&getpods => qw(../lib ../ext);
  45
  46 sub getpods {
  47     if (/\.p(od|m)$/) {
  48         # Skip .pm files that have corresponding .pod files, and Functions.pm.
  49         return if /(.*)\.pm$/ && -f "$1.pod";
  50         my $file = $File::Find::name;
  51         return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
  52
  53         die "tut $name" if $file =~ /TUT/;
  54         unless (open (F, "< $_\0")) {
  55             warn "bogus <$file>: $!";
  56             system "ls", "-l", $file;
  57         }
  58         else {
  59             my $line;
  60             while ($line = <F>) {
  61                 if ($line =~ /^=head1\s+NAME\b/) {
  62                     push @modpods, $file;
  63                     #warn "GOOD $file\n";
  64                     return;
  65                 }
  66             }
  67             warn "EVIL $file\n";
  68         }
  69     }
  70 }
  71
  72 die "no pods" unless @modpods;
  73
  74 for (@modpods) {
  75     #($name) = /(\w+)\.p(m|od)$/;
  76     $name = path2modname($_);
  77     if ($name =~ /^[a-z]/) {
  78         push @pragmata, $_;
  79     } else {
  80         if ($done{$name}++) {
  81             # warn "already did $_\n";
  82             next;
  83         }
  84         push @modules, $_;
  85         push @modname, $name;
  86     }
  87 }
  88
  89 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
  90
  91
  92
  93         =head1 PRAGMA DOCUMENTATION
  94
  95 EOPOD2B
  96
  97 podset(sort @pragmata);
  98
  99 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
 100
 101
 102
 103         =head1 MODULE DOCUMENTATION
 104
 105 EOPOD2B
 106
 107 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
 108
 109 ($_= <<EOPOD2B) =~ s/^\t//gm;
 110
 111
 112         =head1 AUXILIARY DOCUMENTATION
 113
 114         Here should be listed all the extra programs' documentation, but they
 115         don't all have manual pages yet:
 116
 117         =item a2p
 118
 119         =item s2p
 120
 121         =item find2perl
 122
 123         =item h2ph
 124
 125         =item c2ph
 126
 127         =item h2xs
 128
 129         =item xsubpp
 130
 131         =item pod2man
 132
 133         =item wrapsuid
 134
 135
 136         =head1 AUTHOR
 137
 138         Larry Wall <F<larry\@wall.org>>, with the help of oodles
 139         of other folks.
 140
 141
 142 EOPOD2B
 143 output $_;
 144 output "\n";                    # flush $LINE
 145 exit;
 146
 147 sub podset {
 148     local @ARGV = @_;
 149
 150     while(<>) {
 151         if (s/^=head1 (NAME)\s*/=head2 /) {
 152             $pod = path2modname($ARGV);
 153             unitem();
 154             unhead2();
 155             output "\n \n\n=head2 ";
 156             $_ = <>;
 157             if ( /^\s*$pod\b/ ) {
 158                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
 159                 output $_;
 160             } else {
 161                 s/^/$pod, /;
 162                 output $_;
 163             }
 164             next;
 165         }
 166         if (s/^=head1 (.*)/=item $1/) {
 167             unitem(); unhead2();
 168             output $_; nl(); next;
 169         }
 170         if (s/^=head2 (.*)/=item $1/) {
 171             unitem();
 172             output "=over\n\n" unless $inhead2;
 173             $inhead2 = 1;
 174             output $_; nl(); next;
 175
 176         }
 177         if (s/^=item ([^=].*)\n/$1/) {
 178             next if $pod eq 'perldiag';
 179             s/^\s*\*\s*$// && next;
 180             s/^\s*\*\s*//;
 181             s/\s+$//;
 182             next if /^[\d.]+$/;
 183             next if $pod eq 'perlmodlib' && /^ftp:/;
 184             ##print "=over\n\n" unless $initem;
 185             output ", " if $initem;
 186             $initem = 1;
 187             s/\.$//;
 188             s/^-X\b/-I<X>/;
 189             output $_; next;
 190         }
 191     }
 192 }
 193
 194 sub path2modname {
 195     local $_ = shift;
 196     s/\.p(m|od)$//;
 197     s-.*?/(lib|ext)/--;
 198     s-/-::-g;
 199     s/(\w+)::\1/$1/;
 200     return $_;
 201 }
 202
 203 sub unhead2 {
 204     if ($inhead2) {
 205         output "\n\n=back\n\n";
 206     }
 207     $inhead2 = 0;
 208     $initem  = 0;
 209 }
 210
 211 sub unitem {
 212     if ($initem) {
 213         output "\n\n";
 214         ##print "\n\n=back\n\n";
 215     }
 216     $initem = 0;
 217 }
 218
 219 sub nl {
 220     output "\n";
 221 }
 222
 223 my $NEWLINE;    # how many newlines have we seen recently
 224 my $LINE;       # what remains to be printed
 225
 226 sub output ($) {
 227     for (split /(\n)/, shift) {
 228         if ($_ eq "\n") {
 229             if ($LINE) {
 230                 print wrap('', '', $LINE);
 231                 $LINE = '';
 232             }
 233             if ($NEWLINE < 2) {
 234                 print;
 235                 $NEWLINE++;
 236             }
 237         }
 238         elsif (/\S/ && length) {
 239             $LINE .= $_;
 240             $NEWLINE = 0;
 241         }
 242     }
 243 }