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");
203 for (@ARCHPODS) { s/$/.pod/ }
204 @ARCHPODS{@ARCHPODS} = ();
206 for (@pods) { s/$/.pod/ }
210 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
212 if (m!^pod/([^.]+\.pod)\s+!i) {
217 @MANIPODS{@MANIPODS} = ();
219 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
221 if (/^For ease of access, /../^\(If you're intending /) {
222 if (/^\s+(perl\S*)\s+\w/) {
223 push @PERLPODS, "$1.pod";
228 die "$0: could not find the pod listing of perl.pod\n"
230 @PERLPODS{@PERLPODS} = ();
232 # Cross-check against ourselves
233 # Cross-check against the MANIFEST
234 # Cross-check against the perl.pod
236 foreach my $i (sort keys %PODS) {
237 warn "$0: $i exists but is unknown by buildtoc\n"
238 unless exists $pods{$i};
239 warn "$0: $i exists but is unknown by ../MANIFEST\n"
240 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
241 warn "$0: $i exists but is unknown by perl.pod\n"
242 unless exists $PERLPODS{$i};
244 foreach my $i (sort keys %pods) {
245 warn "$0: $i is known by buildtoc but does not exist\n"
246 unless exists $PODS{$i};
248 foreach my $i (sort keys %MANIPODS) {
249 warn "$0: $i is known by ../MANIFEST but does not exist\n"
250 unless exists $PODS{$i};
252 foreach my $i (sort keys %PERLPODS) {
253 warn "$0: $i is known by perl.pod but does not exist\n"
254 unless exists $PODS{$i};
257 # We are ready to rock.
258 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
263 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
267 perltoc - perl documentation table of contents
271 This page provides a brief table of contents for the rest of the Perl
272 documentation set. It is meant to be scanned quickly or grepped
273 through to locate the proper section you're looking for.
275 =head1 BASIC DOCUMENTATION
282 find \&getpods => qw(../lib ../ext);
286 # Skip .pm files that have corresponding .pod files, and Functions.pm.
287 return if /(.*)\.pm$/ && -f "$1.pod";
288 my $file = $File::Find::name;
289 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
290 return if $file =~ m!lib/Attribute/Handlers/demo/!;
291 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
293 die "tut $name" if $file =~ /TUT/;
294 unless (open (F, "< $_\0")) {
295 warn "bogus <$file>: $!";
296 system "ls", "-l", $file;
300 while ($line = <F>) {
301 if ($line =~ /^=head1\s+NAME\b/) {
302 push @modpods, $file;
303 #warn "GOOD $file\n";
307 warn "$0: $file: cannot find =head1 NAME\n";
312 die "no pods" unless @modpods;
315 #($name) = /(\w+)\.p(m|od)$/;
316 $name = path2modname($_);
317 if ($name =~ /^[a-z]/) {
320 if ($done{$name}++) {
321 # warn "already did $_\n";
325 push @modname, $name;
329 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
333 =head1 PRAGMA DOCUMENTATION
337 podset(sort @pragmata);
339 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
343 =head1 MODULE DOCUMENTATION
347 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
349 ($_= <<EOPOD2B) =~ s/^\t//gm;
352 =head1 AUXILIARY DOCUMENTATION
354 Here should be listed all the extra programs' documentation, but they
355 don't all have manual pages yet:
381 Larry Wall <F<larry\@wall.org>>, with the help of oodles
387 output "\n"; # flush $LINE
394 if (s/^=head1 (NAME)\s*/=head2 /) {
395 $pod = path2modname($ARGV);
397 output "\n \n\n=head2 ";
399 if ( /^\s*$pod\b/ ) {
400 s/$pod\.pm/$pod/; # '.pm' in NAME !?
408 if (s/^=head1 (.*)/=item $1/) {
410 output "=over 4\n\n" unless $inhead1;
412 output $_; nl(); next;
414 if (s/^=head2 (.*)/=item $1/) {
416 output "=over 4\n\n" unless $inhead2;
418 output $_; nl(); next;
420 if (s/^=item ([^=].*)/$1/) {
421 next if $pod eq 'perldiag';
422 s/^\s*\*\s*$// && next;
427 next if $pod eq 'perlmodlib' && /^ftp:/;
428 ##print "=over 4\n\n" unless $initem;
429 output ", " if $initem;
435 if (s/^=cut\s*\n//) {
454 output "\n\n=back\n\n";
462 output "\n\n=back\n\n";
470 ##print "\n\n=back\n\n";
479 my $NEWLINE; # how many newlines have we seen recently
480 my $LINE; # what remains to be printed
483 for (split /(\n)/, shift) {
486 print OUT wrap('', '', $LINE);
494 elsif (/\S/ && length) {
503 close OUT or die "Can't close $file: $!";
504 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
505 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';