perl 5.003_07: lib/ExtUtils/xsubpp
[perl.git] / 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<lwall\@sems.com>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