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");
213 for (@ARCHPODS) { s/$/.pod/ }
214 @ARCHPODS{@ARCHPODS} = ();
216 for (@CJKPODS) { s/$/.pod/ }
217 @CJKPODS{@CJKPODS} = ();
219 for (@pods) { s/$/.pod/ }
223 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
225 if (m!^pod/([^.]+\.pod)\s+!i) {
230 @MANIPODS{@MANIPODS} = ();
232 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
234 if (/^For ease of access, /../^\(If you're intending /) {
235 if (/^\s+(perl\S*)\s+\w/) {
236 push @PERLPODS, "$1.pod";
241 die "$0: could not find the pod listing of perl.pod\n"
243 @PERLPODS{@PERLPODS} = ();
245 # Delete the CJK because we cannot mix their encodings.
246 delete @PERLPODS{@CJKPODS};
247 delete @PODS{@CJKPODS};
248 delete @pods{@CJKPODS};
250 # Cross-check against ourselves
251 # Cross-check against the MANIFEST
252 # Cross-check against the perl.pod
254 foreach my $i (sort keys %PODS) {
255 warn "$0: $i exists but is unknown by buildtoc\n"
256 unless exists $pods{$i};
257 warn "$0: $i exists but is unknown by ../MANIFEST\n"
258 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i};
259 warn "$0: $i exists but is unknown by perl.pod\n"
260 unless exists $PERLPODS{$i};
262 foreach my $i (sort keys %pods) {
263 warn "$0: $i is known by buildtoc but does not exist\n"
264 unless exists $PODS{$i};
266 foreach my $i (sort keys %MANIPODS) {
267 warn "$0: $i is known by ../MANIFEST but does not exist\n"
268 unless exists $PODS{$i};
270 foreach my $i (sort keys %PERLPODS) {
271 warn "$0: $i is known by perl.pod but does not exist\n"
272 unless exists $PODS{$i};
275 # We are ready to rock.
276 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
281 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
285 perltoc - perl documentation table of contents
289 This page provides a brief table of contents for the rest of the Perl
290 documentation set. It is meant to be scanned quickly or grepped
291 through to locate the proper section you're looking for.
293 =head1 BASIC DOCUMENTATION
300 find \&getpods => qw(../lib ../ext);
304 my $file = $File::Find::name;
305 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
306 return if $file =~ m!lib/Attribute/Handlers/demo/!;
307 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
308 return if $file =~ m!lib/Math/BigInt/t/!;
309 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
310 die "tut $name" if $file =~ /TUT/;
311 unless (open (F, "< $_\0")) {
312 warn "bogus <$file>: $!";
313 system "ls", "-l", $file;
317 while ($line = <F>) {
318 if ($line =~ /^=head1\s+NAME\b/) {
319 push @modpods, $file;
320 #warn "GOOD $file\n";
324 warn "$0: $file: cannot find =head1 NAME\n";
329 die "no pods" unless @modpods;
332 #($name) = /(\w+)\.p(m|od)$/;
333 $name = path2modname($_);
334 if ($name =~ /^[a-z]/) {
337 if ($done{$name}++) {
338 # warn "already did $_\n";
342 push @modname, $name;
346 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
350 =head1 PRAGMA DOCUMENTATION
354 podset(sort @pragmata);
356 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
360 =head1 MODULE DOCUMENTATION
364 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
366 ($_= <<EOPOD2B) =~ s/^\t//gm;
369 =head1 AUXILIARY DOCUMENTATION
371 Here should be listed all the extra programs' documentation, but they
372 don't all have manual pages yet:
398 Larry Wall <F<larry\@wall.org>>, with the help of oodles
404 output "\n"; # flush $LINE
411 if (s/^=head1 (NAME)\s*/=head2 /) {
412 $pod = path2modname($ARGV);
414 output "\n \n\n=head2 ";
416 if ( /^\s*$pod\b/ ) {
417 s/$pod\.pm/$pod/; # '.pm' in NAME !?
425 if (s/^=head1 (.*)/=item $1/) {
427 output "=over 4\n\n" unless $inhead1;
429 output $_; nl(); next;
431 if (s/^=head2 (.*)/=item $1/) {
433 output "=over 4\n\n" unless $inhead2;
435 output $_; nl(); next;
437 if (s/^=item ([^=].*)/$1/) {
438 next if $pod eq 'perldiag';
439 s/^\s*\*\s*$// && next;
444 next if $pod eq 'perlmodlib' && /^ftp:/;
445 ##print "=over 4\n\n" unless $initem;
446 output ", " if $initem;
452 if (s/^=cut\s*\n//) {
471 output "\n\n=back\n\n";
479 output "\n\n=back\n\n";
487 ##print "\n\n=back\n\n";
496 my $NEWLINE; # how many newlines have we seen recently
497 my $LINE; # what remains to be printed
500 for (split /(\n)/, shift) {
503 print OUT wrap('', '', $LINE);
511 elsif (/\S/ && length) {
520 close OUT or die "Can't close $file: $!";
521 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
522 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';