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");
197 for (@ARCHPODS) { s/$/.pod/ }
198 @ARCHPODS{@ARCHPODS} = ();
200 for (@pods) { s/$/.pod/ }
204 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
206 if (m!^pod/([^.]+\.pod)\s+!i) {
211 @MANIPODS{@MANIPODS} = ();
213 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
215 if (/^For ease of access, /../^\(If you're intending /) {
216 if (/^\s+(perl\S*)\s+\w/) {
217 push @PERLPODS, "$1.pod";
222 die "$0: could not find the pod listing of perl.pod\n"
224 @PERLPODS{@PERLPODS} = ();
226 # Cross-check against ourselves
227 # Cross-check against the MANIFEST
228 # Cross-check against the perl.pod
230 foreach my $i (sort keys %PODS) {
231 warn "$0: $i exists but is unknown by buildtoc\n"
232 unless exists $pods{$i};
233 warn "$0: $i exists but is unknown by ../MANIFEST\n"
234 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
235 warn "$0: $i exists but is unknown by perl.pod\n"
236 unless exists $PERLPODS{$i};
238 foreach my $i (sort keys %pods) {
239 warn "$0: $i is known by buildtoc but does not exist\n"
240 unless exists $PODS{$i};
242 foreach my $i (sort keys %MANIPODS) {
243 warn "$0: $i is known by ../MANIFEST but does not exist\n"
244 unless exists $PODS{$i};
246 foreach my $i (sort keys %PERLPODS) {
247 warn "$0: $i is known by perl.pod but does not exist\n"
248 unless exists $PODS{$i};
251 # We are ready to rock.
252 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
257 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
261 perltoc - perl documentation table of contents
265 This page provides a brief table of contents for the rest of the Perl
266 documentation set. It is meant to be scanned quickly or grepped
267 through to locate the proper section you're looking for.
269 =head1 BASIC DOCUMENTATION
276 find \&getpods => qw(../lib ../ext);
280 # Skip .pm files that have corresponding .pod files, and Functions.pm.
281 return if /(.*)\.pm$/ && -f "$1.pod";
282 my $file = $File::Find::name;
283 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
284 return if $file =~ m!lib/Attribute/Handlers/demo/!;
286 die "tut $name" if $file =~ /TUT/;
287 unless (open (F, "< $_\0")) {
288 warn "bogus <$file>: $!";
289 system "ls", "-l", $file;
293 while ($line = <F>) {
294 if ($line =~ /^=head1\s+NAME\b/) {
295 push @modpods, $file;
296 #warn "GOOD $file\n";
300 warn "$0: $file: cannot find =head1 NAME\n";
305 die "no pods" unless @modpods;
308 #($name) = /(\w+)\.p(m|od)$/;
309 $name = path2modname($_);
310 if ($name =~ /^[a-z]/) {
313 if ($done{$name}++) {
314 # warn "already did $_\n";
318 push @modname, $name;
322 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
326 =head1 PRAGMA DOCUMENTATION
330 podset(sort @pragmata);
332 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
336 =head1 MODULE DOCUMENTATION
340 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
342 ($_= <<EOPOD2B) =~ s/^\t//gm;
345 =head1 AUXILIARY DOCUMENTATION
347 Here should be listed all the extra programs' documentation, but they
348 don't all have manual pages yet:
374 Larry Wall <F<larry\@wall.org>>, with the help of oodles
380 output "\n"; # flush $LINE
387 if (s/^=head1 (NAME)\s*/=head2 /) {
388 $pod = path2modname($ARGV);
390 output "\n \n\n=head2 ";
392 if ( /^\s*$pod\b/ ) {
393 s/$pod\.pm/$pod/; # '.pm' in NAME !?
401 if (s/^=head1 (.*)/=item $1/) {
403 output "=over 4\n\n" unless $inhead1;
405 output $_; nl(); next;
407 if (s/^=head2 (.*)/=item $1/) {
409 output "=over 4\n\n" unless $inhead2;
411 output $_; nl(); next;
413 if (s/^=item ([^=].*)/$1/) {
414 next if $pod eq 'perldiag';
415 s/^\s*\*\s*$// && next;
420 next if $pod eq 'perlmodlib' && /^ftp:/;
421 ##print "=over 4\n\n" unless $initem;
422 output ", " if $initem;
428 if (s/^=cut\s*\n//) {
447 output "\n\n=back\n\n";
455 output "\n\n=back\n\n";
463 ##print "\n\n=back\n\n";
472 my $NEWLINE; # how many newlines have we seen recently
473 my $LINE; # what remains to be printed
476 for (split /(\n)/, shift) {
479 print OUT wrap('', '', $LINE);
487 elsif (/\S/ && length) {
496 close OUT or die "Can't close $file: $!";
497 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
498 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';