4 use File::Basename qw(&basename &dirname);
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
12 # to ensure Configure will look for $Config{startperl}.
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.
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"
22 open OUT,">$file" or die "Can't create $file: $!";
24 print "Extracting $file (with variable substitutions)\n";
26 # In this section, perl variables will be expanded during extraction.
27 # You can use $Config{...} to use Configure variables.
29 print OUT <<"!GROK!THIS!";
31 eval 'exec perl -S \$0 "\$@"'
35 # In the following, perl variables are not expanded during extraction.
37 print OUT <<'!NO!SUBS!';
42 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
43 # This file is autogenerated by buildtoc.PL.
44 # Edit that file and run it to effect changes.
46 # Builds perltoc.pod and sanity checks the list of pods against all
47 # of the MANIFEST, perl.pod, and ourselves.
54 @PODS = glob("*.pod");
59 die "$0: failed to chdir('pod'): $!\n" unless chdir("pod");
215 for (@ARCHPODS) { s/$/.pod/ }
216 @ARCHPODS{@ARCHPODS} = ();
218 for (@CJKPODS) { s/$/.pod/ }
219 @CJKPODS{@CJKPODS} = ();
221 for (@pods) { s/$/.pod/ }
225 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
227 if (m!^pod/([^.]+\.pod)\s+!i) {
232 @MANIPODS{@MANIPODS} = ();
234 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
236 if (/^For ease of access, /../^\(If you're intending /) {
237 if (/^\s+(perl\S*)\s+\w/) {
238 push @PERLPODS, "$1.pod";
243 die "$0: could not find the pod listing of perl.pod\n"
245 @PERLPODS{@PERLPODS} = ();
247 # Delete the CJK because we cannot mix their encodings.
248 delete @PERLPODS{@CJKPODS};
249 delete @PODS{@CJKPODS};
250 delete @pods{@CJKPODS};
252 # Cross-check against ourselves
253 # Cross-check against the MANIFEST
254 # Cross-check against the perl.pod
256 foreach my $i (sort keys %PODS) {
257 warn "$0: $i exists but is unknown by buildtoc\n"
258 unless exists $pods{$i};
259 warn "$0: $i exists but is unknown by ../MANIFEST\n"
260 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i};
261 warn "$0: $i exists but is unknown by perl.pod\n"
262 unless exists $PERLPODS{$i};
264 foreach my $i (sort keys %pods) {
265 warn "$0: $i is known by buildtoc but does not exist\n"
266 unless exists $PODS{$i};
268 foreach my $i (sort keys %MANIPODS) {
269 warn "$0: $i is known by ../MANIFEST but does not exist\n"
270 unless exists $PODS{$i};
272 foreach my $i (sort keys %PERLPODS) {
273 warn "$0: $i is known by perl.pod but does not exist\n"
274 unless exists $PODS{$i};
277 # We are ready to rock.
278 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
283 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
287 perltoc - perl documentation table of contents
291 This page provides a brief table of contents for the rest of the Perl
292 documentation set. It is meant to be scanned quickly or grepped
293 through to locate the proper section you're looking for.
295 =head1 BASIC DOCUMENTATION
302 find \&getpods => qw(../lib ../ext);
306 my $file = $File::Find::name;
307 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
308 return if $file =~ m!lib/Attribute/Handlers/demo/!;
309 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
310 return if $file =~ m!lib/Math/BigInt/t/!;
311 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
312 return if $file =~ m!XS/(?:APItest|Typemap)!;
313 die "tut $name" if $file =~ /TUT/;
314 unless (open (F, "< $_\0")) {
315 warn "bogus <$file>: $!";
316 system "ls", "-l", $file;
320 while ($line = <F>) {
321 if ($line =~ /^=head1\s+NAME\b/) {
322 push @modpods, $file;
323 #warn "GOOD $file\n";
327 warn "$0: $file: cannot find =head1 NAME\n";
332 die "no pods" unless @modpods;
335 #($name) = /(\w+)\.p(m|od)$/;
336 $name = path2modname($_);
337 if ($name =~ /^[a-z]/) {
340 if ($done{$name}++) {
341 # warn "already did $_\n";
345 push @modname, $name;
349 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
353 =head1 PRAGMA DOCUMENTATION
357 podset(sort @pragmata);
359 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
363 =head1 MODULE DOCUMENTATION
367 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
369 ($_= <<EOPOD2B) =~ s/^\t//gm;
372 =head1 AUXILIARY DOCUMENTATION
374 Here should be listed all the extra programs' documentation, but they
375 don't all have manual pages yet:
401 Larry Wall <F<larry\@wall.org>>, with the help of oodles
407 output "\n"; # flush $LINE
414 if (s/^=head1 (NAME)\s*/=head2 /) {
415 $pod = path2modname($ARGV);
417 output "\n \n\n=head2 ";
419 if ( /^\s*$pod\b/ ) {
420 s/$pod\.pm/$pod/; # '.pm' in NAME !?
428 if (s/^=head1 (.*)/=item $1/) {
430 output "=over 4\n\n" unless $inhead1;
432 output $_; nl(); next;
434 if (s/^=head2 (.*)/=item $1/) {
436 output "=over 4\n\n" unless $inhead2;
438 output $_; nl(); next;
440 if (s/^=item ([^=].*)/$1/) {
441 next if $pod eq 'perldiag';
442 s/^\s*\*\s*$// && next;
447 next if $pod eq 'perlmodlib' && /^ftp:/;
448 ##print "=over 4\n\n" unless $initem;
449 output ", " if $initem;
455 if (s/^=cut\s*\n//) {
474 output "\n\n=back\n\n";
482 output "\n\n=back\n\n";
490 ##print "\n\n=back\n\n";
499 my $NEWLINE; # how many newlines have we seen recently
500 my $LINE; # what remains to be printed
503 for (split /(\n)/, shift) {
506 print OUT wrap('', '', $LINE);
514 elsif (/\S/ && length) {
523 close OUT or die "Can't close $file: $!";
524 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
525 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';