pod/buildtoc

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