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");
191 for (@ARCHPODS) { s/$/.pod/ }
192 @ARCHPODS{@ARCHPODS} = ();
194 for (@pods) { s/$/.pod/ }
198 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
200 if (m!^pod/([^.]+\.pod)\s+!i) {
205 @MANIPODS{@MANIPODS} = ();
207 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
209 if (/^For ease of access, /../^\(If you're intending /) {
210 if (/^\s+(perl\S*)\s+\w/) {
211 push @PERLPODS, "$1.pod";
216 die "$0: could not find the pod listing of perl.pod\n"
218 @PERLPODS{@PERLPODS} = ();
220 # Cross-check against ourselves
221 # Cross-check against the MANIFEST
222 # Cross-check against the perl.pod
224 foreach my $i (sort keys %PODS) {
225 warn "$0: $i exists but is unknown by buildtoc\n"
226 unless exists $pods{$i};
227 warn "$0: $i exists but is unknown by ../MANIFEST\n"
228 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
229 warn "$0: $i exists but is unknown by perl.pod\n"
230 unless exists $PERLPODS{$i};
232 foreach my $i (sort keys %pods) {
233 warn "$0: $i is known by buildtoc but does not exist\n"
234 unless exists $PODS{$i};
236 foreach my $i (sort keys %MANIPODS) {
237 warn "$0: $i is known by ../MANIFEST but does not exist\n"
238 unless exists $PODS{$i};
240 foreach my $i (sort keys %PERLPODS) {
241 warn "$0: $i is known by perl.pod but does not exist\n"
242 unless exists $PODS{$i};
245 # We are ready to rock.
246 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
251 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
255 perltoc - perl documentation table of contents
259 This page provides a brief table of contents for the rest of the Perl
260 documentation set. It is meant to be scanned quickly or grepped
261 through to locate the proper section you're looking for.
263 =head1 BASIC DOCUMENTATION
270 find \&getpods => qw(../lib ../ext);
274 # Skip .pm files that have corresponding .pod files, and Functions.pm.
275 return if /(.*)\.pm$/ && -f "$1.pod";
276 my $file = $File::Find::name;
277 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
279 die "tut $name" if $file =~ /TUT/;
280 unless (open (F, "< $_\0")) {
281 warn "bogus <$file>: $!";
282 system "ls", "-l", $file;
286 while ($line = <F>) {
287 if ($line =~ /^=head1\s+NAME\b/) {
288 push @modpods, $file;
289 #warn "GOOD $file\n";
293 warn "$0: $file: cannot find =head1 NAME\n";
298 die "no pods" unless @modpods;
301 #($name) = /(\w+)\.p(m|od)$/;
302 $name = path2modname($_);
303 if ($name =~ /^[a-z]/) {
306 if ($done{$name}++) {
307 # warn "already did $_\n";
311 push @modname, $name;
315 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
319 =head1 PRAGMA DOCUMENTATION
323 podset(sort @pragmata);
325 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
329 =head1 MODULE DOCUMENTATION
333 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
335 ($_= <<EOPOD2B) =~ s/^\t//gm;
338 =head1 AUXILIARY DOCUMENTATION
340 Here should be listed all the extra programs' documentation, but they
341 don't all have manual pages yet:
367 Larry Wall <F<larry\@wall.org>>, with the help of oodles
373 output "\n"; # flush $LINE
380 if (s/^=head1 (NAME)\s*/=head2 /) {
381 $pod = path2modname($ARGV);
383 output "\n \n\n=head2 ";
385 if ( /^\s*$pod\b/ ) {
386 s/$pod\.pm/$pod/; # '.pm' in NAME !?
394 if (s/^=head1 (.*)/=item $1/) {
396 output "=over 4\n\n" unless $inhead1;
398 output $_; nl(); next;
400 if (s/^=head2 (.*)/=item $1/) {
402 output "=over 4\n\n" unless $inhead2;
404 output $_; nl(); next;
406 if (s/^=item ([^=].*)/$1/) {
407 next if $pod eq 'perldiag';
408 s/^\s*\*\s*$// && next;
413 next if $pod eq 'perlmodlib' && /^ftp:/;
414 ##print "=over 4\n\n" unless $initem;
415 output ", " if $initem;
421 if (s/^=cut\s*\n//) {
440 output "\n\n=back\n\n";
448 output "\n\n=back\n\n";
456 ##print "\n\n=back\n\n";
465 my $NEWLINE; # how many newlines have we seen recently
466 my $LINE; # what remains to be printed
469 for (split /(\n)/, shift) {
472 print OUT wrap('', '', $LINE);
480 elsif (/\S/ && length) {
489 close OUT or die "Can't close $file: $!";
490 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
491 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';