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");
204 for (@ARCHPODS) { s/$/.pod/ }
205 @ARCHPODS{@ARCHPODS} = ();
207 for (@pods) { s/$/.pod/ }
211 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
213 if (m!^pod/([^.]+\.pod)\s+!i) {
218 @MANIPODS{@MANIPODS} = ();
220 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
222 if (/^For ease of access, /../^\(If you're intending /) {
223 if (/^\s+(perl\S*)\s+\w/) {
224 push @PERLPODS, "$1.pod";
229 die "$0: could not find the pod listing of perl.pod\n"
231 @PERLPODS{@PERLPODS} = ();
233 # Cross-check against ourselves
234 # Cross-check against the MANIFEST
235 # Cross-check against the perl.pod
237 foreach my $i (sort keys %PODS) {
238 warn "$0: $i exists but is unknown by buildtoc\n"
239 unless exists $pods{$i};
240 warn "$0: $i exists but is unknown by ../MANIFEST\n"
241 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
242 warn "$0: $i exists but is unknown by perl.pod\n"
243 unless exists $PERLPODS{$i};
245 foreach my $i (sort keys %pods) {
246 warn "$0: $i is known by buildtoc but does not exist\n"
247 unless exists $PODS{$i};
249 foreach my $i (sort keys %MANIPODS) {
250 warn "$0: $i is known by ../MANIFEST but does not exist\n"
251 unless exists $PODS{$i};
253 foreach my $i (sort keys %PERLPODS) {
254 warn "$0: $i is known by perl.pod but does not exist\n"
255 unless exists $PODS{$i};
258 # We are ready to rock.
259 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
264 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
268 perltoc - perl documentation table of contents
272 This page provides a brief table of contents for the rest of the Perl
273 documentation set. It is meant to be scanned quickly or grepped
274 through to locate the proper section you're looking for.
276 =head1 BASIC DOCUMENTATION
283 find \&getpods => qw(../lib ../ext);
287 # Skip .pm files that have corresponding .pod files, and Functions.pm.
288 return if /(.*)\.pm$/ && -f "$1.pod";
289 my $file = $File::Find::name;
290 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
291 return if $file =~ m!lib/Attribute/Handlers/demo/!;
292 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
293 return if $file =~ m!lib/Math/BigInt/t/!;
295 die "tut $name" if $file =~ /TUT/;
296 unless (open (F, "< $_\0")) {
297 warn "bogus <$file>: $!";
298 system "ls", "-l", $file;
302 while ($line = <F>) {
303 if ($line =~ /^=head1\s+NAME\b/) {
304 push @modpods, $file;
305 #warn "GOOD $file\n";
309 warn "$0: $file: cannot find =head1 NAME\n";
314 die "no pods" unless @modpods;
317 #($name) = /(\w+)\.p(m|od)$/;
318 $name = path2modname($_);
319 if ($name =~ /^[a-z]/) {
322 if ($done{$name}++) {
323 # warn "already did $_\n";
327 push @modname, $name;
331 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
335 =head1 PRAGMA DOCUMENTATION
339 podset(sort @pragmata);
341 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
345 =head1 MODULE DOCUMENTATION
349 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
351 ($_= <<EOPOD2B) =~ s/^\t//gm;
354 =head1 AUXILIARY DOCUMENTATION
356 Here should be listed all the extra programs' documentation, but they
357 don't all have manual pages yet:
383 Larry Wall <F<larry\@wall.org>>, with the help of oodles
389 output "\n"; # flush $LINE
396 if (s/^=head1 (NAME)\s*/=head2 /) {
397 $pod = path2modname($ARGV);
399 output "\n \n\n=head2 ";
401 if ( /^\s*$pod\b/ ) {
402 s/$pod\.pm/$pod/; # '.pm' in NAME !?
410 if (s/^=head1 (.*)/=item $1/) {
412 output "=over 4\n\n" unless $inhead1;
414 output $_; nl(); next;
416 if (s/^=head2 (.*)/=item $1/) {
418 output "=over 4\n\n" unless $inhead2;
420 output $_; nl(); next;
422 if (s/^=item ([^=].*)/$1/) {
423 next if $pod eq 'perldiag';
424 s/^\s*\*\s*$// && next;
429 next if $pod eq 'perlmodlib' && /^ftp:/;
430 ##print "=over 4\n\n" unless $initem;
431 output ", " if $initem;
437 if (s/^=cut\s*\n//) {
456 output "\n\n=back\n\n";
464 output "\n\n=back\n\n";
472 ##print "\n\n=back\n\n";
481 my $NEWLINE; # how many newlines have we seen recently
482 my $LINE; # what remains to be printed
485 for (split /(\n)/, shift) {
488 print OUT wrap('', '', $LINE);
496 elsif (/\S/ && length) {
505 close OUT or die "Can't close $file: $!";
506 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
507 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';