pod/buildtoc

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