pod/buildtoc

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