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");
216 for (@ARCHPODS) { s/$/.pod/ }
217 @ARCHPODS{@ARCHPODS} = ();
219 for (@CJKPODS) { s/$/.pod/ }
220 @CJKPODS{@CJKPODS} = ();
222 for (@pods) { s/$/.pod/ }
226 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
228 if (m!^pod/([^.]+\.pod)\s+!i) {
233 @MANIPODS{@MANIPODS} = ();
235 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
237 if (/^For ease of access, /../^\(If you're intending /) {
238 if (/^\s+(perl\S*)\s+\w/) {
239 push @PERLPODS, "$1.pod";
244 die "$0: could not find the pod listing of perl.pod\n"
246 @PERLPODS{@PERLPODS} = ();
248 # Delete the CJK because we cannot mix their encodings.
249 delete @PERLPODS{@CJKPODS};
250 delete @PODS{@CJKPODS};
251 delete @pods{@CJKPODS};
253 # Cross-check against ourselves
254 # Cross-check against the MANIFEST
255 # Cross-check against the perl.pod
257 foreach my $i (sort keys %PODS) {
258 warn "$0: $i exists but is unknown by buildtoc\n"
259 unless exists $pods{$i};
260 warn "$0: $i exists but is unknown by ../MANIFEST\n"
261 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i};
262 warn "$0: $i exists but is unknown by perl.pod\n"
263 unless exists $PERLPODS{$i};
265 foreach my $i (sort keys %pods) {
266 warn "$0: $i is known by buildtoc but does not exist\n"
267 unless exists $PODS{$i};
269 foreach my $i (sort keys %MANIPODS) {
270 warn "$0: $i is known by ../MANIFEST but does not exist\n"
271 unless exists $PODS{$i};
273 foreach my $i (sort keys %PERLPODS) {
274 warn "$0: $i is known by perl.pod but does not exist\n"
275 unless exists $PODS{$i};
278 # We are ready to rock.
279 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
284 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
288 perltoc - perl documentation table of contents
292 This page provides a brief table of contents for the rest of the Perl
293 documentation set. It is meant to be scanned quickly or grepped
294 through to locate the proper section you're looking for.
296 =head1 BASIC DOCUMENTATION
303 find \&getpods => qw(../lib ../ext);
307 my $file = $File::Find::name;
308 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
309 return if $file =~ m!lib/Attribute/Handlers/demo/!;
310 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
311 return if $file =~ m!lib/Math/BigInt/t/!;
312 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
313 return if $file =~ m!XS/(?:APItest|Typemap)!;
314 die "tut $name" if $file =~ /TUT/;
315 unless (open (F, "< $_\0")) {
316 warn "bogus <$file>: $!";
317 system "ls", "-l", $file;
321 while ($line = <F>) {
322 if ($line =~ /^=head1\s+NAME\b/) {
323 push @modpods, $file;
324 #warn "GOOD $file\n";
328 warn "$0: $file: cannot find =head1 NAME\n";
333 die "no pods" unless @modpods;
336 #($name) = /(\w+)\.p(m|od)$/;
337 $name = path2modname($_);
338 if ($name =~ /^[a-z]/) {
341 if ($done{$name}++) {
342 # warn "already did $_\n";
346 push @modname, $name;
350 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
354 =head1 PRAGMA DOCUMENTATION
358 podset(sort @pragmata);
360 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
364 =head1 MODULE DOCUMENTATION
368 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
370 ($_= <<EOPOD2B) =~ s/^\t//gm;
373 =head1 AUXILIARY DOCUMENTATION
375 Here should be listed all the extra programs' documentation, but they
376 don't all have manual pages yet:
402 Larry Wall <F<larry\@wall.org>>, with the help of oodles
408 output "\n"; # flush $LINE
415 if (s/^=head1 (NAME)\s*/=head2 /) {
416 $pod = path2modname($ARGV);
418 output "\n \n\n=head2 ";
420 if ( /^\s*$pod\b/ ) {
421 s/$pod\.pm/$pod/; # '.pm' in NAME !?
429 if (s/^=head1 (.*)/=item $1/) {
431 output "=over 4\n\n" unless $inhead1;
433 output $_; nl(); next;
435 if (s/^=head2 (.*)/=item $1/) {
437 output "=over 4\n\n" unless $inhead2;
439 output $_; nl(); next;
441 if (s/^=item ([^=].*)/$1/) {
442 next if $pod eq 'perldiag';
443 s/^\s*\*\s*$// && next;
448 next if $pod eq 'perlmodlib' && /^ftp:/;
449 ##print "=over 4\n\n" unless $initem;
450 output ", " if $initem;
456 if (s/^=cut\s*\n//) {
475 output "\n\n=back\n\n";
483 output "\n\n=back\n\n";
491 ##print "\n\n=back\n\n";
500 my $NEWLINE; # how many newlines have we seen recently
501 my $LINE; # what remains to be printed
504 for (split /(\n)/, shift) {
507 print OUT wrap('', '', $LINE);
515 elsif (/\S/ && length) {
524 close OUT or die "Can't close $file: $!";
525 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
526 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';