tiny Changes edit
[p5sagit/p5-mst-13.2.git] / pod / buildtoc.PL
CommitLineData
4755096e 1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
5use Cwd;
6
7# List explicitly here the variables you want Configure to
8# generate. Metaconfig only looks for shell variables, so you
9# have to mention them as if they were shell variables, not
10# %Config entries. Thus you write
11# $startperl
12# to ensure Configure will look for $Config{startperl}.
13
14# This forces PL files to create target in same directory as PL file.
15# This is so that make depend always knows where to find PL derivatives.
16$origdir = cwd;
17chdir(dirname($0));
18($file = basename($0)) =~ s/\.PL$//;
19$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
20$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
21
22open OUT,">$file" or die "Can't create $file: $!";
23
24print "Extracting $file (with variable substitutions)\n";
25
26# In this section, perl variables will be expanded during extraction.
27# You can use $Config{...} to use Configure variables.
28
29print OUT <<"!GROK!THIS!";
30$Config{'startperl'}
31 eval 'exec perl -S \$0 "\$@"'
32 if 0;
33!GROK!THIS!
34
35# In the following, perl variables are not expanded during extraction.
36
37print OUT <<'!NO!SUBS!';
38
39#
40# buildtoc
41#
42# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
43# This file is autogenerated by buildtoc.PL.
44# Edit that file and run it to effect changes.
45#
46# Builds perltoc.pod and sanity checks the list of pods against all
47# of the MANIFEST, perl.pod, and ourselves.
48#
49
50use File::Find;
51use Cwd;
52use Text::Wrap;
53
54@PODS = glob("*.pod");
55
56sub output ($);
57
58if (-d "pod") {
59 die "$0: failed to chdir('pod'): $!\n" unless chdir("pod");
60}
61
62@pods = qw(
c2e66d9e 63 perl
64 perlfaq
65 perltoc
66 perlbook
67
68 perlsyn
69 perldata
70 perlop
71 perlsub
72 perlfunc
73 perlreftut
74 perldsc
75 perlrequick
76 perlpod
77 perlstyle
78 perltrap
79
80 perlrun
81 perldiag
82 perllexwarn
83 perldebug
84
85 perlvar
86 perllol
87 perlopentut
88 perlretut
89
90 perlref
91 perlre
92 perlform
93 perllocale
94 perlunicode
95
96 perlipc
97 perlfork
98 perlnumber
99 perlthrtut
100
101 perlport
102 perlsec
103
104 perlboot
105 perltoot
106 perltootc
107 perlobj
108 perlbot
109 perltie
110
111 perlmod
112 perlmodlib
113 perlmodinstall
114 perlnewmod
115
4755096e 116 perlfaq1
117 perlfaq2
118 perlfaq3
119 perlfaq4
120 perlfaq5
121 perlfaq6
122 perlfaq7
123 perlfaq8
124 perlfaq9
125
126 perlcompile
127
128 perlembed
129 perldebguts
130 perlxstut
131 perlxs
132 perlguts
133 perlcall
134 perlutil
135 perlfilter
136 perldbmfilter
137 perlapi
138 perlintern
139 perlapio
140 perltodo
141 perlhack
142
143 perlhist
144 perldelta
145 perl56delta
146 perl5005delta
147 perl5004delta
148
149 perlamiga
150 perlcygwin
151 perldos
152 perlhpux
153 perlmachten
154 perlos2
155 perlos390
c2e66d9e 156 perlposix-bc
4755096e 157 perlvms
158 perlwin32
159 );
160
161@ARCHPODS = qw(
162 perlamiga
163 perlcygwin
164 perldos
165 perlhpux
166 perlmachten
167 perlos2
168 perlos390
c2e66d9e 169 perlposix-bc
4755096e 170 perlvms
171 perlwin32
172 );
173for (@ARCHPODS) { s/$/.pod/ }
174@ARCHPODS{@ARCHPODS} = ();
175
176for (@pods) { s/$/.pod/ }
177@pods{@pods} = ();
178@PODS{@PODS} = ();
179
180open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
181while (<MANI>) {
182 if (m!^pod/([^.]+\.pod)\s+!i) {
183 push @MANIPODS, $1;
184 }
185}
186close(MANI);
187@MANIPODS{@MANIPODS} = ();
188
189open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
190while (<PERLPOD>) {
191 if (/^For ease of access, /../^\(If you're intending /) {
c2e66d9e 192 if (/^\s+(perl\S*)\s+\w/) {
4755096e 193 push @PERLPODS, "$1.pod";
194 }
195 }
196}
197close(PERLPOD);
198die "$0: could not find the pod listing of perl.pod\n"
199 unless @PERLPODS;
200@PERLPODS{@PERLPODS} = ();
201
202# Cross-check against ourselves
203# Cross-check against the MANIFEST
204# Cross-check against the perl.pod
205
206foreach my $i (sort keys %PODS) {
207 warn "$0: $i exists but is unknown by buildtoc\n"
208 unless exists $pods{$i};
209 warn "$0: $i exists but is unknown by ../MANIFEST\n"
210 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
211 warn "$0: $i exists but is unknown by perl.pod\n"
212 unless exists $PERLPODS{$i};
213}
214foreach my $i (sort keys %pods) {
215 warn "$0: $i is known by buildtoc but does not exist\n"
216 unless exists $PODS{$i};
217}
218foreach my $i (sort keys %MANIPODS) {
219 warn "$0: $i is known by ../MANIFEST but does not exist\n"
220 unless exists $PODS{$i};
221}
222foreach my $i (sort keys %PERLPODS) {
223 warn "$0: $i is known by perl.pod but does not exist\n"
224 unless exists $PODS{$i};
225}
226
227# We are ready to rock.
228open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
229
230$/ = '';
231@ARGV = @pods;
232
233($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
234
235 =head1 NAME
236
237 perltoc - perl documentation table of contents
238
239 =head1 DESCRIPTION
240
241 This page provides a brief table of contents for the rest of the Perl
242 documentation set. It is meant to be scanned quickly or grepped
243 through to locate the proper section you're looking for.
244
245 =head1 BASIC DOCUMENTATION
246
247EOPOD2B
248#' make emacs happy
249
250podset(@pods);
251
252find \&getpods => qw(../lib ../ext);
253
254sub getpods {
255 if (/\.p(od|m)$/) {
256 # Skip .pm files that have corresponding .pod files, and Functions.pm.
257 return if /(.*)\.pm$/ && -f "$1.pod";
258 my $file = $File::Find::name;
259 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
260
261 die "tut $name" if $file =~ /TUT/;
262 unless (open (F, "< $_\0")) {
263 warn "bogus <$file>: $!";
264 system "ls", "-l", $file;
265 }
266 else {
267 my $line;
268 while ($line = <F>) {
269 if ($line =~ /^=head1\s+NAME\b/) {
270 push @modpods, $file;
271 #warn "GOOD $file\n";
272 return;
273 }
274 }
275 warn "$0: $file: cannot find =head1 NAME\n";
276 }
277 }
278}
279
280die "no pods" unless @modpods;
281
282for (@modpods) {
283 #($name) = /(\w+)\.p(m|od)$/;
284 $name = path2modname($_);
285 if ($name =~ /^[a-z]/) {
286 push @pragmata, $_;
287 } else {
288 if ($done{$name}++) {
289 # warn "already did $_\n";
290 next;
291 }
292 push @modules, $_;
293 push @modname, $name;
294 }
295}
296
297($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
298
299
300
301 =head1 PRAGMA DOCUMENTATION
302
303EOPOD2B
304
305podset(sort @pragmata);
306
307($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
308
309
310
311 =head1 MODULE DOCUMENTATION
312
313EOPOD2B
314
315podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
316
317($_= <<EOPOD2B) =~ s/^\t//gm;
318
319
320 =head1 AUXILIARY DOCUMENTATION
321
322 Here should be listed all the extra programs' documentation, but they
323 don't all have manual pages yet:
324
325 =over
326
327 =item a2p
328
329 =item s2p
330
331 =item find2perl
332
333 =item h2ph
334
335 =item c2ph
336
337 =item h2xs
338
339 =item xsubpp
340
341 =item pod2man
342
343 =item wrapsuid
344
345 =back
346
347 =head1 AUTHOR
348
349 Larry Wall <F<larry\@wall.org>>, with the help of oodles
350 of other folks.
351
352
353EOPOD2B
354output $_;
355output "\n"; # flush $LINE
356exit;
357
358sub podset {
359 local @ARGV = @_;
360
361 while(<>) {
362 if (s/^=head1 (NAME)\s*/=head2 /) {
363 $pod = path2modname($ARGV);
364 unhead1();
365 output "\n \n\n=head2 ";
366 $_ = <>;
367 if ( /^\s*$pod\b/ ) {
368 s/$pod\.pm/$pod/; # '.pm' in NAME !?
369 output $_;
370 } else {
371 s/^/$pod, /;
372 output $_;
373 }
374 next;
375 }
376 if (s/^=head1 (.*)/=item $1/) {
377 unhead2();
378 output "=over\n\n" unless $inhead1;
379 $inhead1 = 1;
380 output $_; nl(); next;
381 }
382 if (s/^=head2 (.*)/=item $1/) {
383 unitem();
384 output "=over\n\n" unless $inhead2;
385 $inhead2 = 1;
386 output $_; nl(); next;
387 }
388 if (s/^=item ([^=].*)/$1/) {
389 next if $pod eq 'perldiag';
390 s/^\s*\*\s*$// && next;
391 s/^\s*\*\s*//;
392 s/\n/ /g;
393 s/\s+$//;
394 next if /^[\d.]+$/;
395 next if $pod eq 'perlmodlib' && /^ftp:/;
396 ##print "=over\n\n" unless $initem;
397 output ", " if $initem;
398 $initem = 1;
399 s/\.$//;
400 s/^-X\b/-I<X>/;
401 output $_; next;
402 }
403 if (s/^=cut\s*\n//) {
404 unhead1();
405 next;
406 }
407 }
408}
409
410sub path2modname {
411 local $_ = shift;
412 s/\.p(m|od)$//;
413 s-.*?/(lib|ext)/--;
414 s-/-::-g;
415 s/(\w+)::\1/$1/;
416 return $_;
417}
418
419sub unhead1 {
420 unhead2();
421 if ($inhead1) {
422 output "\n\n=back\n\n";
423 }
424 $inhead1 = 0;
425}
426
427sub unhead2 {
428 unitem();
429 if ($inhead2) {
430 output "\n\n=back\n\n";
431 }
432 $inhead2 = 0;
433}
434
435sub unitem {
436 if ($initem) {
437 output "\n\n";
438 ##print "\n\n=back\n\n";
439 }
440 $initem = 0;
441}
442
443sub nl {
444 output "\n";
445}
446
447my $NEWLINE; # how many newlines have we seen recently
448my $LINE; # what remains to be printed
449
450sub output ($) {
451 for (split /(\n)/, shift) {
452 if ($_ eq "\n") {
453 if ($LINE) {
454 print OUT wrap('', '', $LINE);
455 $LINE = '';
456 }
457 if ($NEWLINE < 2) {
458 print OUT;
459 $NEWLINE++;
460 }
461 }
462 elsif (/\S/ && length) {
463 $LINE .= $_;
464 $NEWLINE = 0;
465 }
466 }
467}
468
469!NO!SUBS!
470