This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
OS/400 PASE port
[perl5.git] / pod / buildtoc.PL
CommitLineData
4755096e
GS
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
a83b6f46
JH
62@ARCHPODS = qw(
63 perlaix
64 perlapollo
65 perlamiga
66 perlbeos
67 perlbs2000
a1f19229 68 perlce
a83b6f46
JH
69 perlcygwin
70 perldgux
71 perldos
72 perlepoc
18a271bd 73 perlfreebsd
a83b6f46
JH
74 perlhpux
75 perlhurd
469e7be4 76 perlirix
a83b6f46
JH
77 perlmachten
78 perlmacos
79 perlmint
80 perlmpeix
9038e305 81 perlnetware
a83b6f46
JH
82 perlos2
83 perlos390
522b859a 84 perlos400
a83b6f46
JH
85 perlqnx
86 perlplan9
87 perlsolaris
88 perltru64
91144103 89 perluts
a83b6f46
JH
90 perlvmesa
91 perlvms
92 perlvos
93 perlwin32
94 );
95
d8416318
JH
96@CJKPODS = qw(
97 perlcn
98 perljp
99 perlko
100 perltw
101 );
102
a83b6f46
JH
103@pods =
104 (
105 qw(
106
c2e66d9e 107 perl
10151d09 108 perlintro
c2e66d9e
GS
109 perlfaq
110 perltoc
111 perlbook
112
113 perlsyn
114 perldata
115 perlop
116 perlsub
117 perlfunc
118 perlreftut
119 perldsc
120 perlrequick
121 perlpod
8a93676d 122 perlpodspec
c2e66d9e
GS
123 perlstyle
124 perltrap
125
126 perlrun
127 perldiag
128 perllexwarn
10862624 129 perldebtut
c2e66d9e
GS
130 perldebug
131
132 perlvar
133 perllol
134 perlopentut
34babc16 135 perlpacktut
c2e66d9e
GS
136 perlretut
137
c2e66d9e 138 perlre
d396a558
JH
139 perlref
140
c2e66d9e 141 perlform
d396a558
JH
142
143 perlboot
144 perltoot
890a53b9 145 perltooc
d396a558
JH
146 perlobj
147 perlbot
148 perltie
c2e66d9e
GS
149
150 perlipc
151 perlfork
152 perlnumber
53d7eaa8 153
c2e66d9e 154 perlthrtut
53d7eaa8 155 perlothrtut
c2e66d9e
GS
156
157 perlport
d396a558 158 perllocale
07fcf8ff 159 perluniintro
d396a558
JH
160 perlunicode
161 perlebcdic
c2e66d9e 162
d396a558 163 perlsec
c2e66d9e
GS
164
165 perlmod
c2e66d9e 166 perlmodinstall
35bf961c
JH
167 perlmodlib
168 perlmodstyle
c2e66d9e
GS
169 perlnewmod
170
4755096e
GS
171 perlfaq1
172 perlfaq2
173 perlfaq3
174 perlfaq4
175 perlfaq5
176 perlfaq6
177 perlfaq7
178 perlfaq8
179 perlfaq9
180
181 perlcompile
182
183 perlembed
184 perldebguts
185 perlxstut
186 perlxs
f40a6c71 187 perlclib
4755096e
GS
188 perlguts
189 perlcall
190 perlutil
191 perlfilter
192 perldbmfilter
193 perlapi
194 perlintern
dc5c060f 195 perliol
4755096e
GS
196 perlapio
197 perltodo
198 perlhack
199
200 perlhist
201 perldelta
245d750e 202 perl572delta
1db9e106
JH
203 perl571delta
204 perl570delta
493a87da 205 perl561delta
4755096e
GS
206 perl56delta
207 perl5005delta
208 perl5004delta
209
a83b6f46
JH
210 ),
211
d8416318 212 @ARCHPODS,
a83b6f46
JH
213
214 );
4755096e 215
4755096e
GS
216for (@ARCHPODS) { s/$/.pod/ }
217@ARCHPODS{@ARCHPODS} = ();
218
d8416318
JH
219for (@CJKPODS) { s/$/.pod/ }
220@CJKPODS{@CJKPODS} = ();
221
4755096e
GS
222for (@pods) { s/$/.pod/ }
223@pods{@pods} = ();
224@PODS{@PODS} = ();
225
226open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
227while (<MANI>) {
228 if (m!^pod/([^.]+\.pod)\s+!i) {
229 push @MANIPODS, $1;
230 }
231}
232close(MANI);
233@MANIPODS{@MANIPODS} = ();
234
235open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
236while (<PERLPOD>) {
237 if (/^For ease of access, /../^\(If you're intending /) {
c2e66d9e 238 if (/^\s+(perl\S*)\s+\w/) {
4755096e
GS
239 push @PERLPODS, "$1.pod";
240 }
241 }
242}
243close(PERLPOD);
244die "$0: could not find the pod listing of perl.pod\n"
245 unless @PERLPODS;
246@PERLPODS{@PERLPODS} = ();
247
d8416318
JH
248# Delete the CJK because we cannot mix their encodings.
249delete @PERLPODS{@CJKPODS};
250delete @PODS{@CJKPODS};
251delete @pods{@CJKPODS};
252
4755096e
GS
253# Cross-check against ourselves
254# Cross-check against the MANIFEST
255# Cross-check against the perl.pod
256
257foreach my $i (sort keys %PODS) {
258 warn "$0: $i exists but is unknown by buildtoc\n"
259 unless exists $pods{$i};
260 warn "$0: $i exists but is unknown by ../MANIFEST\n"
d8416318 261 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i};
4755096e
GS
262 warn "$0: $i exists but is unknown by perl.pod\n"
263 unless exists $PERLPODS{$i};
264}
265foreach my $i (sort keys %pods) {
266 warn "$0: $i is known by buildtoc but does not exist\n"
267 unless exists $PODS{$i};
268}
269foreach my $i (sort keys %MANIPODS) {
270 warn "$0: $i is known by ../MANIFEST but does not exist\n"
271 unless exists $PODS{$i};
272}
273foreach my $i (sort keys %PERLPODS) {
274 warn "$0: $i is known by perl.pod but does not exist\n"
275 unless exists $PODS{$i};
276}
277
278# We are ready to rock.
279open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
280
281$/ = '';
282@ARGV = @pods;
283
284($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
285
286 =head1 NAME
287
288 perltoc - perl documentation table of contents
289
290 =head1 DESCRIPTION
291
292 This page provides a brief table of contents for the rest of the Perl
293 documentation set. It is meant to be scanned quickly or grepped
294 through to locate the proper section you're looking for.
295
296 =head1 BASIC DOCUMENTATION
297
298EOPOD2B
299#' make emacs happy
300
301podset(@pods);
302
303find \&getpods => qw(../lib ../ext);
304
305sub getpods {
306 if (/\.p(od|m)$/) {
4755096e 307 my $file = $File::Find::name;
ad716b8e 308 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
a83b6f46 309 return if $file =~ m!lib/Attribute/Handlers/demo/!;
ad716b8e 310 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
ba62762e 311 return if $file =~ m!lib/Math/BigInt/t/!;
ad716b8e
JH
312 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
313 return if $file =~ m!XS/(?:APItest|Typemap)!;
314 die "tut $name" if $file =~ /TUT/;
4755096e
GS
315 unless (open (F, "< $_\0")) {
316 warn "bogus <$file>: $!";
317 system "ls", "-l", $file;
318 }
319 else {
320 my $line;
321 while ($line = <F>) {
322 if ($line =~ /^=head1\s+NAME\b/) {
323 push @modpods, $file;
324 #warn "GOOD $file\n";
325 return;
326 }
327 }
328 warn "$0: $file: cannot find =head1 NAME\n";
329 }
330 }
331}
332
333die "no pods" unless @modpods;
334
335for (@modpods) {
336 #($name) = /(\w+)\.p(m|od)$/;
337 $name = path2modname($_);
338 if ($name =~ /^[a-z]/) {
339 push @pragmata, $_;
340 } else {
341 if ($done{$name}++) {
342 # warn "already did $_\n";
343 next;
344 }
345 push @modules, $_;
346 push @modname, $name;
347 }
348}
349
350($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
351
352
353
354 =head1 PRAGMA DOCUMENTATION
355
356EOPOD2B
357
358podset(sort @pragmata);
359
360($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
361
362
363
364 =head1 MODULE DOCUMENTATION
365
366EOPOD2B
367
368podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
369
370($_= <<EOPOD2B) =~ s/^\t//gm;
371
372
373 =head1 AUXILIARY DOCUMENTATION
374
375 Here should be listed all the extra programs' documentation, but they
376 don't all have manual pages yet:
377
13a2d996 378 =over 4
4755096e
GS
379
380 =item a2p
381
382 =item s2p
383
384 =item find2perl
385
386 =item h2ph
387
388 =item c2ph
389
390 =item h2xs
391
392 =item xsubpp
393
394 =item pod2man
395
396 =item wrapsuid
397
398 =back
399
400 =head1 AUTHOR
401
402 Larry Wall <F<larry\@wall.org>>, with the help of oodles
403 of other folks.
404
405
406EOPOD2B
407output $_;
408output "\n"; # flush $LINE
409exit;
410
411sub podset {
412 local @ARGV = @_;
413
414 while(<>) {
415 if (s/^=head1 (NAME)\s*/=head2 /) {
416 $pod = path2modname($ARGV);
417 unhead1();
418 output "\n \n\n=head2 ";
419 $_ = <>;
420 if ( /^\s*$pod\b/ ) {
421 s/$pod\.pm/$pod/; # '.pm' in NAME !?
422 output $_;
423 } else {
424 s/^/$pod, /;
425 output $_;
426 }
427 next;
428 }
429 if (s/^=head1 (.*)/=item $1/) {
430 unhead2();
13a2d996 431 output "=over 4\n\n" unless $inhead1;
4755096e
GS
432 $inhead1 = 1;
433 output $_; nl(); next;
434 }
435 if (s/^=head2 (.*)/=item $1/) {
436 unitem();
13a2d996 437 output "=over 4\n\n" unless $inhead2;
4755096e
GS
438 $inhead2 = 1;
439 output $_; nl(); next;
440 }
441 if (s/^=item ([^=].*)/$1/) {
442 next if $pod eq 'perldiag';
443 s/^\s*\*\s*$// && next;
444 s/^\s*\*\s*//;
445 s/\n/ /g;
446 s/\s+$//;
447 next if /^[\d.]+$/;
448 next if $pod eq 'perlmodlib' && /^ftp:/;
13a2d996 449 ##print "=over 4\n\n" unless $initem;
4755096e
GS
450 output ", " if $initem;
451 $initem = 1;
452 s/\.$//;
453 s/^-X\b/-I<X>/;
454 output $_; next;
455 }
456 if (s/^=cut\s*\n//) {
457 unhead1();
458 next;
459 }
460 }
461}
462
463sub path2modname {
464 local $_ = shift;
465 s/\.p(m|od)$//;
466 s-.*?/(lib|ext)/--;
467 s-/-::-g;
468 s/(\w+)::\1/$1/;
469 return $_;
470}
471
472sub unhead1 {
473 unhead2();
474 if ($inhead1) {
475 output "\n\n=back\n\n";
476 }
477 $inhead1 = 0;
478}
479
480sub unhead2 {
481 unitem();
482 if ($inhead2) {
483 output "\n\n=back\n\n";
484 }
485 $inhead2 = 0;
486}
487
488sub unitem {
489 if ($initem) {
490 output "\n\n";
491 ##print "\n\n=back\n\n";
492 }
493 $initem = 0;
494}
495
496sub nl {
497 output "\n";
498}
499
500my $NEWLINE; # how many newlines have we seen recently
501my $LINE; # what remains to be printed
502
503sub output ($) {
504 for (split /(\n)/, shift) {
505 if ($_ eq "\n") {
506 if ($LINE) {
507 print OUT wrap('', '', $LINE);
508 $LINE = '';
509 }
510 if ($NEWLINE < 2) {
511 print OUT;
512 $NEWLINE++;
513 }
514 }
515 elsif (/\S/ && length) {
516 $LINE .= $_;
517 $NEWLINE = 0;
518 }
519 }
520}
521
522!NO!SUBS!
523
6bbf1b34 524close OUT or die "Can't close $file: $!";
525chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
526exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
527chdir $origdir;