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");
223 for (@ARCHPODS) { s/$/.pod/ }
224 @ARCHPODS{@ARCHPODS} = ();
226 for (@CJKPODS) { s/$/.pod/ }
227 @CJKPODS{@CJKPODS} = ();
229 for (@pods) { s/$/.pod/ }
233 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
235 if (m!^pod/([^.]+\.pod)\s+!i) {
240 @MANIPODS{@MANIPODS} = ();
242 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
244 if (/^For ease of access, /../^\(If you're intending /) {
245 if (/^\s+(perl\S*)\s+\w/) {
246 push @PERLPODS, "$1.pod";
251 die "$0: could not find the pod listing of perl.pod\n"
253 @PERLPODS{@PERLPODS} = ();
255 # Delete the CJK because we cannot mix their encodings.
256 delete @PERLPODS{@CJKPODS};
257 delete @PODS{@CJKPODS};
258 delete @pods{@CJKPODS};
260 # Cross-check against ourselves
261 # Cross-check against the MANIFEST
262 # Cross-check against the perl.pod
264 foreach my $i (sort keys %PODS) {
265 warn "$0: $i exists but is unknown by buildtoc\n"
266 unless exists $pods{$i};
267 warn "$0: $i exists but is unknown by ../MANIFEST\n"
268 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i};
269 warn "$0: $i exists but is unknown by perl.pod\n"
270 unless exists $PERLPODS{$i};
272 foreach my $i (sort keys %pods) {
273 warn "$0: $i is known by buildtoc but does not exist\n"
274 unless exists $PODS{$i};
276 foreach my $i (sort keys %MANIPODS) {
277 warn "$0: $i is known by ../MANIFEST but does not exist\n"
278 unless exists $PODS{$i};
280 foreach my $i (sort keys %PERLPODS) {
281 warn "$0: $i is known by perl.pod but does not exist\n"
282 unless exists $PODS{$i};
285 # We are ready to rock.
286 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
291 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
295 perltoc - perl documentation table of contents
299 This page provides a brief table of contents for the rest of the Perl
300 documentation set. It is meant to be scanned quickly or grepped
301 through to locate the proper section you're looking for.
303 =head1 BASIC DOCUMENTATION
310 find \&getpods => qw(../lib ../ext);
314 my $file = $File::Find::name;
315 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
316 return if $file =~ m!(?:^|/)t/!;
317 return if $file =~ m!lib/Attribute/Handlers/demo/!;
318 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
319 return if $file =~ m!lib/Math/BigInt/t/!;
320 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
321 return if $file =~ m!XS/(?:APItest|Typemap)!;
322 die "tut $name" if $file =~ /TUT/;
323 unless (open (F, "< $_\0")) {
324 warn "bogus <$file>: $!";
325 system "ls", "-l", $file;
329 while ($line = <F>) {
330 if ($line =~ /^=head1\s+NAME\b/) {
331 push @modpods, $file;
332 #warn "GOOD $file\n";
336 warn "$0: $file: cannot find =head1 NAME\n";
341 die "no pods" unless @modpods;
344 #($name) = /(\w+)\.p(m|od)$/;
345 $name = path2modname($_);
346 if ($name =~ /^[a-z]/) {
349 if ($done{$name}++) {
350 # warn "already did $_\n";
354 push @modname, $name;
358 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
362 =head1 PRAGMA DOCUMENTATION
366 podset(sort @pragmata);
368 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
372 =head1 MODULE DOCUMENTATION
376 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
378 ($_= <<EOPOD2B) =~ s/^\t//gm;
381 =head1 AUXILIARY DOCUMENTATION
383 Here should be listed all the extra programs' documentation, but they
384 don't all have manual pages yet:
410 Larry Wall <F<larry\@wall.org>>, with the help of oodles
416 output "\n"; # flush $LINE
423 if (s/^=head1 (NAME)\s*/=head2 /) {
424 $pod = path2modname($ARGV);
426 output "\n \n\n=head2 ";
428 if ( /^\s*$pod\b/ ) {
429 s/$pod\.pm/$pod/; # '.pm' in NAME !?
437 if (s/^=head1 (.*)/=item $1/) {
439 output "=over 4\n\n" unless $inhead1;
441 output $_; nl(); next;
443 if (s/^=head2 (.*)/=item $1/) {
445 output "=over 4\n\n" unless $inhead2;
447 output $_; nl(); next;
449 if (s/^=item ([^=].*)/$1/) {
450 next if $pod eq 'perldiag';
451 s/^\s*\*\s*$// && next;
456 next if $pod eq 'perlmodlib' && /^ftp:/;
457 ##print "=over 4\n\n" unless $initem;
458 output ", " if $initem;
464 if (s/^=cut\s*\n//) {
483 output "\n\n=back\n\n";
491 output "\n\n=back\n\n";
499 ##print "\n\n=back\n\n";
508 my $NEWLINE; # how many newlines have we seen recently
509 my $LINE; # what remains to be printed
512 for (split /(\n)/, shift) {
515 print OUT wrap('', '', $LINE);
523 elsif (/\S/ && length) {
532 close OUT or die "Can't close $file: $!";
533 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
534 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';