Commit | Line | Data |
---|---|---|
4755096e GS |
1 | #!/usr/local/bin/perl |
2 | ||
3 | use Config; | |
4 | use File::Basename qw(&basename &dirname); | |
5 | use 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; | |
17 | chdir(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 | ||
22 | open OUT,">$file" or die "Can't create $file: $!"; | |
23 | ||
24 | print "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 | ||
29 | print 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 | ||
37 | print 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 | ||
50 | use File::Find; | |
51 | use Cwd; | |
52 | use Text::Wrap; | |
53 | ||
54 | @PODS = glob("*.pod"); | |
55 | ||
56 | sub output ($); | |
57 | ||
58 | if (-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 | |
2a551100 | 199 | perldoc |
4755096e GS |
200 | |
201 | perlhist | |
202 | perldelta | |
2a551100 | 203 | perl58delta |
77b096b5 | 204 | perl573delta |
245d750e | 205 | perl572delta |
1db9e106 JH |
206 | perl571delta |
207 | perl570delta | |
493a87da | 208 | perl561delta |
4755096e GS |
209 | perl56delta |
210 | perl5005delta | |
211 | perl5004delta | |
212 | ||
2a551100 JH |
213 | perlartistic |
214 | perlgpl | |
215 | ||
a83b6f46 JH |
216 | ), |
217 | ||
d8416318 | 218 | @ARCHPODS, |
a83b6f46 JH |
219 | |
220 | ); | |
4755096e | 221 | |
4755096e GS |
222 | for (@ARCHPODS) { s/$/.pod/ } |
223 | @ARCHPODS{@ARCHPODS} = (); | |
224 | ||
d8416318 JH |
225 | for (@CJKPODS) { s/$/.pod/ } |
226 | @CJKPODS{@CJKPODS} = (); | |
227 | ||
4755096e GS |
228 | for (@pods) { s/$/.pod/ } |
229 | @pods{@pods} = (); | |
230 | @PODS{@PODS} = (); | |
231 | ||
232 | open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!"; | |
233 | while (<MANI>) { | |
234 | if (m!^pod/([^.]+\.pod)\s+!i) { | |
235 | push @MANIPODS, $1; | |
236 | } | |
237 | } | |
238 | close(MANI); | |
239 | @MANIPODS{@MANIPODS} = (); | |
240 | ||
241 | open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n"; | |
242 | while (<PERLPOD>) { | |
243 | if (/^For ease of access, /../^\(If you're intending /) { | |
c2e66d9e | 244 | if (/^\s+(perl\S*)\s+\w/) { |
4755096e GS |
245 | push @PERLPODS, "$1.pod"; |
246 | } | |
247 | } | |
248 | } | |
249 | close(PERLPOD); | |
250 | die "$0: could not find the pod listing of perl.pod\n" | |
251 | unless @PERLPODS; | |
252 | @PERLPODS{@PERLPODS} = (); | |
253 | ||
d8416318 JH |
254 | # Delete the CJK because we cannot mix their encodings. |
255 | delete @PERLPODS{@CJKPODS}; | |
256 | delete @PODS{@CJKPODS}; | |
257 | delete @pods{@CJKPODS}; | |
258 | ||
4755096e GS |
259 | # Cross-check against ourselves |
260 | # Cross-check against the MANIFEST | |
261 | # Cross-check against the perl.pod | |
262 | ||
263 | foreach my $i (sort keys %PODS) { | |
264 | warn "$0: $i exists but is unknown by buildtoc\n" | |
265 | unless exists $pods{$i}; | |
266 | warn "$0: $i exists but is unknown by ../MANIFEST\n" | |
d8416318 | 267 | if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i}; |
4755096e GS |
268 | warn "$0: $i exists but is unknown by perl.pod\n" |
269 | unless exists $PERLPODS{$i}; | |
270 | } | |
271 | foreach my $i (sort keys %pods) { | |
272 | warn "$0: $i is known by buildtoc but does not exist\n" | |
273 | unless exists $PODS{$i}; | |
274 | } | |
275 | foreach my $i (sort keys %MANIPODS) { | |
276 | warn "$0: $i is known by ../MANIFEST but does not exist\n" | |
277 | unless exists $PODS{$i}; | |
278 | } | |
279 | foreach my $i (sort keys %PERLPODS) { | |
280 | warn "$0: $i is known by perl.pod but does not exist\n" | |
281 | unless exists $PODS{$i}; | |
282 | } | |
283 | ||
284 | # We are ready to rock. | |
285 | open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!"; | |
286 | ||
287 | $/ = ''; | |
288 | @ARGV = @pods; | |
289 | ||
290 | ($_= <<EOPOD2B) =~ s/^\t//gm && output($_); | |
291 | ||
292 | =head1 NAME | |
293 | ||
294 | perltoc - perl documentation table of contents | |
295 | ||
296 | =head1 DESCRIPTION | |
297 | ||
298 | This page provides a brief table of contents for the rest of the Perl | |
299 | documentation set. It is meant to be scanned quickly or grepped | |
300 | through to locate the proper section you're looking for. | |
301 | ||
302 | =head1 BASIC DOCUMENTATION | |
303 | ||
304 | EOPOD2B | |
305 | #' make emacs happy | |
306 | ||
307 | podset(@pods); | |
308 | ||
309 | find \&getpods => qw(../lib ../ext); | |
310 | ||
311 | sub getpods { | |
312 | if (/\.p(od|m)$/) { | |
4755096e | 313 | my $file = $File::Find::name; |
ad716b8e | 314 | return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself |
2a551100 | 315 | return if $file =~ m!(?:^|/)t/!; |
a83b6f46 | 316 | return if $file =~ m!lib/Attribute/Handlers/demo/!; |
ad716b8e | 317 | return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-) |
ba62762e | 318 | return if $file =~ m!lib/Math/BigInt/t/!; |
ad716b8e JH |
319 | return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i; |
320 | return if $file =~ m!XS/(?:APItest|Typemap)!; | |
321 | die "tut $name" if $file =~ /TUT/; | |
4755096e GS |
322 | unless (open (F, "< $_\0")) { |
323 | warn "bogus <$file>: $!"; | |
324 | system "ls", "-l", $file; | |
325 | } | |
326 | else { | |
327 | my $line; | |
328 | while ($line = <F>) { | |
329 | if ($line =~ /^=head1\s+NAME\b/) { | |
330 | push @modpods, $file; | |
331 | #warn "GOOD $file\n"; | |
332 | return; | |
333 | } | |
334 | } | |
335 | warn "$0: $file: cannot find =head1 NAME\n"; | |
336 | } | |
337 | } | |
338 | } | |
339 | ||
340 | die "no pods" unless @modpods; | |
341 | ||
342 | for (@modpods) { | |
343 | #($name) = /(\w+)\.p(m|od)$/; | |
344 | $name = path2modname($_); | |
345 | if ($name =~ /^[a-z]/) { | |
346 | push @pragmata, $_; | |
347 | } else { | |
348 | if ($done{$name}++) { | |
349 | # warn "already did $_\n"; | |
350 | next; | |
351 | } | |
352 | push @modules, $_; | |
353 | push @modname, $name; | |
354 | } | |
355 | } | |
356 | ||
357 | ($_= <<EOPOD2B) =~ s/^\t//gm && output($_); | |
358 | ||
359 | ||
360 | ||
361 | =head1 PRAGMA DOCUMENTATION | |
362 | ||
363 | EOPOD2B | |
364 | ||
365 | podset(sort @pragmata); | |
366 | ||
367 | ($_= <<EOPOD2B) =~ s/^\t//gm && output($_); | |
368 | ||
369 | ||
370 | ||
371 | =head1 MODULE DOCUMENTATION | |
372 | ||
373 | EOPOD2B | |
374 | ||
375 | podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] ); | |
376 | ||
377 | ($_= <<EOPOD2B) =~ s/^\t//gm; | |
378 | ||
379 | ||
380 | =head1 AUXILIARY DOCUMENTATION | |
381 | ||
382 | Here should be listed all the extra programs' documentation, but they | |
383 | don't all have manual pages yet: | |
384 | ||
13a2d996 | 385 | =over 4 |
4755096e GS |
386 | |
387 | =item a2p | |
388 | ||
389 | =item s2p | |
390 | ||
391 | =item find2perl | |
392 | ||
393 | =item h2ph | |
394 | ||
395 | =item c2ph | |
396 | ||
397 | =item h2xs | |
398 | ||
399 | =item xsubpp | |
400 | ||
401 | =item pod2man | |
402 | ||
403 | =item wrapsuid | |
404 | ||
405 | =back | |
406 | ||
407 | =head1 AUTHOR | |
408 | ||
409 | Larry Wall <F<larry\@wall.org>>, with the help of oodles | |
410 | of other folks. | |
411 | ||
412 | ||
413 | EOPOD2B | |
414 | output $_; | |
415 | output "\n"; # flush $LINE | |
416 | exit; | |
417 | ||
418 | sub podset { | |
419 | local @ARGV = @_; | |
420 | ||
421 | while(<>) { | |
422 | if (s/^=head1 (NAME)\s*/=head2 /) { | |
423 | $pod = path2modname($ARGV); | |
424 | unhead1(); | |
425 | output "\n \n\n=head2 "; | |
426 | $_ = <>; | |
427 | if ( /^\s*$pod\b/ ) { | |
428 | s/$pod\.pm/$pod/; # '.pm' in NAME !? | |
429 | output $_; | |
430 | } else { | |
431 | s/^/$pod, /; | |
432 | output $_; | |
433 | } | |
434 | next; | |
435 | } | |
436 | if (s/^=head1 (.*)/=item $1/) { | |
437 | unhead2(); | |
13a2d996 | 438 | output "=over 4\n\n" unless $inhead1; |
4755096e GS |
439 | $inhead1 = 1; |
440 | output $_; nl(); next; | |
441 | } | |
442 | if (s/^=head2 (.*)/=item $1/) { | |
443 | unitem(); | |
13a2d996 | 444 | output "=over 4\n\n" unless $inhead2; |
4755096e GS |
445 | $inhead2 = 1; |
446 | output $_; nl(); next; | |
447 | } | |
448 | if (s/^=item ([^=].*)/$1/) { | |
449 | next if $pod eq 'perldiag'; | |
450 | s/^\s*\*\s*$// && next; | |
451 | s/^\s*\*\s*//; | |
452 | s/\n/ /g; | |
453 | s/\s+$//; | |
454 | next if /^[\d.]+$/; | |
455 | next if $pod eq 'perlmodlib' && /^ftp:/; | |
13a2d996 | 456 | ##print "=over 4\n\n" unless $initem; |
4755096e GS |
457 | output ", " if $initem; |
458 | $initem = 1; | |
459 | s/\.$//; | |
460 | s/^-X\b/-I<X>/; | |
461 | output $_; next; | |
462 | } | |
463 | if (s/^=cut\s*\n//) { | |
464 | unhead1(); | |
465 | next; | |
466 | } | |
467 | } | |
468 | } | |
469 | ||
470 | sub path2modname { | |
471 | local $_ = shift; | |
472 | s/\.p(m|od)$//; | |
473 | s-.*?/(lib|ext)/--; | |
474 | s-/-::-g; | |
475 | s/(\w+)::\1/$1/; | |
476 | return $_; | |
477 | } | |
478 | ||
479 | sub unhead1 { | |
480 | unhead2(); | |
481 | if ($inhead1) { | |
482 | output "\n\n=back\n\n"; | |
483 | } | |
484 | $inhead1 = 0; | |
485 | } | |
486 | ||
487 | sub unhead2 { | |
488 | unitem(); | |
489 | if ($inhead2) { | |
490 | output "\n\n=back\n\n"; | |
491 | } | |
492 | $inhead2 = 0; | |
493 | } | |
494 | ||
495 | sub unitem { | |
496 | if ($initem) { | |
497 | output "\n\n"; | |
498 | ##print "\n\n=back\n\n"; | |
499 | } | |
500 | $initem = 0; | |
501 | } | |
502 | ||
503 | sub nl { | |
504 | output "\n"; | |
505 | } | |
506 | ||
507 | my $NEWLINE; # how many newlines have we seen recently | |
508 | my $LINE; # what remains to be printed | |
509 | ||
510 | sub output ($) { | |
511 | for (split /(\n)/, shift) { | |
512 | if ($_ eq "\n") { | |
513 | if ($LINE) { | |
514 | print OUT wrap('', '', $LINE); | |
515 | $LINE = ''; | |
516 | } | |
517 | if ($NEWLINE < 2) { | |
518 | print OUT; | |
519 | $NEWLINE++; | |
520 | } | |
521 | } | |
522 | elsif (/\S/ && length) { | |
523 | $LINE .= $_; | |
524 | $NEWLINE = 0; | |
525 | } | |
526 | } | |
527 | } | |
528 | ||
529 | !NO!SUBS! | |
530 | ||
6bbf1b34 LM |
531 | close OUT or die "Can't close $file: $!"; |
532 | chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; | |
533 | exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; | |
534 | chdir $origdir; |