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