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