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");
202 for (@ARCHPODS) { s/$/.pod/ }
203 @ARCHPODS{@ARCHPODS} = ();
205 for (@pods) { s/$/.pod/ }
209 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
211 if (m!^pod/([^.]+\.pod)\s+!i) {
216 @MANIPODS{@MANIPODS} = ();
218 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
220 if (/^For ease of access, /../^\(If you're intending /) {
221 if (/^\s+(perl\S*)\s+\w/) {
222 push @PERLPODS, "$1.pod";
227 die "$0: could not find the pod listing of perl.pod\n"
229 @PERLPODS{@PERLPODS} = ();
231 # Cross-check against ourselves
232 # Cross-check against the MANIFEST
233 # Cross-check against the perl.pod
235 foreach my $i (sort keys %PODS) {
236 warn "$0: $i exists but is unknown by buildtoc\n"
237 unless exists $pods{$i};
238 warn "$0: $i exists but is unknown by ../MANIFEST\n"
239 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
240 warn "$0: $i exists but is unknown by perl.pod\n"
241 unless exists $PERLPODS{$i};
243 foreach my $i (sort keys %pods) {
244 warn "$0: $i is known by buildtoc but does not exist\n"
245 unless exists $PODS{$i};
247 foreach my $i (sort keys %MANIPODS) {
248 warn "$0: $i is known by ../MANIFEST but does not exist\n"
249 unless exists $PODS{$i};
251 foreach my $i (sort keys %PERLPODS) {
252 warn "$0: $i is known by perl.pod but does not exist\n"
253 unless exists $PODS{$i};
256 # We are ready to rock.
257 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
262 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
266 perltoc - perl documentation table of contents
270 This page provides a brief table of contents for the rest of the Perl
271 documentation set. It is meant to be scanned quickly or grepped
272 through to locate the proper section you're looking for.
274 =head1 BASIC DOCUMENTATION
281 find \&getpods => qw(../lib ../ext);
285 # Skip .pm files that have corresponding .pod files, and Functions.pm.
286 return if /(.*)\.pm$/ && -f "$1.pod";
287 my $file = $File::Find::name;
288 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
289 return if $file =~ m!lib/Attribute/Handlers/demo/!;
291 die "tut $name" if $file =~ /TUT/;
292 unless (open (F, "< $_\0")) {
293 warn "bogus <$file>: $!";
294 system "ls", "-l", $file;
298 while ($line = <F>) {
299 if ($line =~ /^=head1\s+NAME\b/) {
300 push @modpods, $file;
301 #warn "GOOD $file\n";
305 warn "$0: $file: cannot find =head1 NAME\n";
310 die "no pods" unless @modpods;
313 #($name) = /(\w+)\.p(m|od)$/;
314 $name = path2modname($_);
315 if ($name =~ /^[a-z]/) {
318 if ($done{$name}++) {
319 # warn "already did $_\n";
323 push @modname, $name;
327 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
331 =head1 PRAGMA DOCUMENTATION
335 podset(sort @pragmata);
337 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
341 =head1 MODULE DOCUMENTATION
345 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
347 ($_= <<EOPOD2B) =~ s/^\t//gm;
350 =head1 AUXILIARY DOCUMENTATION
352 Here should be listed all the extra programs' documentation, but they
353 don't all have manual pages yet:
379 Larry Wall <F<larry\@wall.org>>, with the help of oodles
385 output "\n"; # flush $LINE
392 if (s/^=head1 (NAME)\s*/=head2 /) {
393 $pod = path2modname($ARGV);
395 output "\n \n\n=head2 ";
397 if ( /^\s*$pod\b/ ) {
398 s/$pod\.pm/$pod/; # '.pm' in NAME !?
406 if (s/^=head1 (.*)/=item $1/) {
408 output "=over 4\n\n" unless $inhead1;
410 output $_; nl(); next;
412 if (s/^=head2 (.*)/=item $1/) {
414 output "=over 4\n\n" unless $inhead2;
416 output $_; nl(); next;
418 if (s/^=item ([^=].*)/$1/) {
419 next if $pod eq 'perldiag';
420 s/^\s*\*\s*$// && next;
425 next if $pod eq 'perlmodlib' && /^ftp:/;
426 ##print "=over 4\n\n" unless $initem;
427 output ", " if $initem;
433 if (s/^=cut\s*\n//) {
452 output "\n\n=back\n\n";
460 output "\n\n=back\n\n";
468 ##print "\n\n=back\n\n";
477 my $NEWLINE; # how many newlines have we seen recently
478 my $LINE; # what remains to be printed
481 for (split /(\n)/, shift) {
484 print OUT wrap('', '', $LINE);
492 elsif (/\S/ && length) {
501 close OUT or die "Can't close $file: $!";
502 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
503 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';