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");
224 for (@ARCHPODS) { s/$/.pod/ }
225 @ARCHPODS{@ARCHPODS} = ();
227 for (@CJKPODS) { s/$/.pod/ }
228 @CJKPODS{@CJKPODS} = ();
230 for (@pods) { s/$/.pod/ }
234 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
236 if (m!^pod/([^.]+\.pod)\s+!i) {
241 @MANIPODS{@MANIPODS} = ();
243 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
245 if (/^For ease of access, /../^\(If you're intending /) {
246 if (/^\s+(perl\S*)\s+\w/) {
247 push @PERLPODS, "$1.pod";
252 die "$0: could not find the pod listing of perl.pod\n"
254 @PERLPODS{@PERLPODS} = ();
256 # Delete the CJK because we cannot mix their encodings.
257 delete @PERLPODS{@CJKPODS};
258 delete @PODS{@CJKPODS};
259 delete @pods{@CJKPODS};
261 # Cross-check against ourselves
262 # Cross-check against the MANIFEST
263 # Cross-check against the perl.pod
265 foreach my $i (sort keys %PODS) {
266 warn "$0: $i exists but is unknown by buildtoc\n"
267 unless exists $pods{$i};
268 warn "$0: $i exists but is unknown by ../MANIFEST\n"
269 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i};
270 warn "$0: $i exists but is unknown by perl.pod\n"
271 unless exists $PERLPODS{$i};
273 foreach my $i (sort keys %pods) {
274 warn "$0: $i is known by buildtoc but does not exist\n"
275 unless exists $PODS{$i};
277 foreach my $i (sort keys %MANIPODS) {
278 warn "$0: $i is known by ../MANIFEST but does not exist\n"
279 unless exists $PODS{$i};
281 foreach my $i (sort keys %PERLPODS) {
282 warn "$0: $i is known by perl.pod but does not exist\n"
283 unless exists $PODS{$i};
286 # We are ready to rock.
287 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
292 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
296 perltoc - perl documentation table of contents
300 This page provides a brief table of contents for the rest of the Perl
301 documentation set. It is meant to be scanned quickly or grepped
302 through to locate the proper section you're looking for.
304 =head1 BASIC DOCUMENTATION
311 find \&getpods => qw(../lib ../ext);
315 my $file = $File::Find::name;
316 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
317 return if $file =~ m!(?:^|/)t/!;
318 return if $file =~ m!lib/Attribute/Handlers/demo/!;
319 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
320 return if $file =~ m!lib/Math/BigInt/t/!;
321 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
322 return if $file =~ m!XS/(?:APItest|Typemap)!;
323 die "tut $name" if $file =~ /TUT/;
324 unless (open (F, "< $_\0")) {
325 warn "bogus <$file>: $!";
326 system "ls", "-l", $file;
330 while ($line = <F>) {
331 if ($line =~ /^=head1\s+NAME\b/) {
332 push @modpods, $file;
333 #warn "GOOD $file\n";
337 warn "$0: $file: cannot find =head1 NAME\n";
342 die "no pods" unless @modpods;
345 #($name) = /(\w+)\.p(m|od)$/;
346 $name = path2modname($_);
347 if ($name =~ /^[a-z]/) {
350 if ($done{$name}++) {
351 # warn "already did $_\n";
355 push @modname, $name;
359 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
363 =head1 PRAGMA DOCUMENTATION
367 podset(sort @pragmata);
369 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
373 =head1 MODULE DOCUMENTATION
377 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
379 ($_= <<EOPOD2B) =~ s/^\t//gm;
382 =head1 AUXILIARY DOCUMENTATION
384 Here should be listed all the extra programs' documentation, but they
385 don't all have manual pages yet:
411 Larry Wall <F<larry\@wall.org>>, with the help of oodles
417 output "\n"; # flush $LINE
424 if (s/^=head1 (NAME)\s*/=head2 /) {
425 $pod = path2modname($ARGV);
427 output "\n \n\n=head2 ";
429 if ( /^\s*$pod\b/ ) {
430 s/$pod\.pm/$pod/; # '.pm' in NAME !?
438 if (s/^=head1 (.*)/=item $1/) {
440 output "=over 4\n\n" unless $inhead1;
442 output $_; nl(); next;
444 if (s/^=head2 (.*)/=item $1/) {
446 output "=over 4\n\n" unless $inhead2;
448 output $_; nl(); next;
450 if (s/^=item ([^=].*)/$1/) {
451 next if $pod eq 'perldiag';
452 s/^\s*\*\s*$// && next;
457 next if $pod eq 'perlmodlib' && /^ftp:/;
458 ##print "=over 4\n\n" unless $initem;
459 output ", " if $initem;
465 if (s/^=cut\s*\n//) {
484 output "\n\n=back\n\n";
492 output "\n\n=back\n\n";
500 ##print "\n\n=back\n\n";
509 my $NEWLINE; # how many newlines have we seen recently
510 my $LINE; # what remains to be printed
513 for (split /(\n)/, shift) {
516 print OUT wrap('', '', $LINE);
524 elsif (/\S/ && length) {
533 close OUT or die "Can't close $file: $!";
534 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
535 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';