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