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");
200 for (@ARCHPODS) { s/$/.pod/ }
201 @ARCHPODS{@ARCHPODS} = ();
203 for (@pods) { s/$/.pod/ }
207 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
209 if (m!^pod/([^.]+\.pod)\s+!i) {
214 @MANIPODS{@MANIPODS} = ();
216 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
218 if (/^For ease of access, /../^\(If you're intending /) {
219 if (/^\s+(perl\S*)\s+\w/) {
220 push @PERLPODS, "$1.pod";
225 die "$0: could not find the pod listing of perl.pod\n"
227 @PERLPODS{@PERLPODS} = ();
229 # Cross-check against ourselves
230 # Cross-check against the MANIFEST
231 # Cross-check against the perl.pod
233 foreach my $i (sort keys %PODS) {
234 warn "$0: $i exists but is unknown by buildtoc\n"
235 unless exists $pods{$i};
236 warn "$0: $i exists but is unknown by ../MANIFEST\n"
237 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
238 warn "$0: $i exists but is unknown by perl.pod\n"
239 unless exists $PERLPODS{$i};
241 foreach my $i (sort keys %pods) {
242 warn "$0: $i is known by buildtoc but does not exist\n"
243 unless exists $PODS{$i};
245 foreach my $i (sort keys %MANIPODS) {
246 warn "$0: $i is known by ../MANIFEST but does not exist\n"
247 unless exists $PODS{$i};
249 foreach my $i (sort keys %PERLPODS) {
250 warn "$0: $i is known by perl.pod but does not exist\n"
251 unless exists $PODS{$i};
254 # We are ready to rock.
255 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
260 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
264 perltoc - perl documentation table of contents
268 This page provides a brief table of contents for the rest of the Perl
269 documentation set. It is meant to be scanned quickly or grepped
270 through to locate the proper section you're looking for.
272 =head1 BASIC DOCUMENTATION
279 find \&getpods => qw(../lib ../ext);
283 # Skip .pm files that have corresponding .pod files, and Functions.pm.
284 return if /(.*)\.pm$/ && -f "$1.pod";
285 my $file = $File::Find::name;
286 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
287 return if $file =~ m!lib/Attribute/Handlers/demo/!;
289 die "tut $name" if $file =~ /TUT/;
290 unless (open (F, "< $_\0")) {
291 warn "bogus <$file>: $!";
292 system "ls", "-l", $file;
296 while ($line = <F>) {
297 if ($line =~ /^=head1\s+NAME\b/) {
298 push @modpods, $file;
299 #warn "GOOD $file\n";
303 warn "$0: $file: cannot find =head1 NAME\n";
308 die "no pods" unless @modpods;
311 #($name) = /(\w+)\.p(m|od)$/;
312 $name = path2modname($_);
313 if ($name =~ /^[a-z]/) {
316 if ($done{$name}++) {
317 # warn "already did $_\n";
321 push @modname, $name;
325 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
329 =head1 PRAGMA DOCUMENTATION
333 podset(sort @pragmata);
335 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
339 =head1 MODULE DOCUMENTATION
343 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
345 ($_= <<EOPOD2B) =~ s/^\t//gm;
348 =head1 AUXILIARY DOCUMENTATION
350 Here should be listed all the extra programs' documentation, but they
351 don't all have manual pages yet:
377 Larry Wall <F<larry\@wall.org>>, with the help of oodles
383 output "\n"; # flush $LINE
390 if (s/^=head1 (NAME)\s*/=head2 /) {
391 $pod = path2modname($ARGV);
393 output "\n \n\n=head2 ";
395 if ( /^\s*$pod\b/ ) {
396 s/$pod\.pm/$pod/; # '.pm' in NAME !?
404 if (s/^=head1 (.*)/=item $1/) {
406 output "=over 4\n\n" unless $inhead1;
408 output $_; nl(); next;
410 if (s/^=head2 (.*)/=item $1/) {
412 output "=over 4\n\n" unless $inhead2;
414 output $_; nl(); next;
416 if (s/^=item ([^=].*)/$1/) {
417 next if $pod eq 'perldiag';
418 s/^\s*\*\s*$// && next;
423 next if $pod eq 'perlmodlib' && /^ftp:/;
424 ##print "=over 4\n\n" unless $initem;
425 output ", " if $initem;
431 if (s/^=cut\s*\n//) {
450 output "\n\n=back\n\n";
458 output "\n\n=back\n\n";
466 ##print "\n\n=back\n\n";
475 my $NEWLINE; # how many newlines have we seen recently
476 my $LINE; # what remains to be printed
479 for (split /(\n)/, shift) {
482 print OUT wrap('', '', $LINE);
490 elsif (/\S/ && length) {
499 close OUT or die "Can't close $file: $!";
500 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
501 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';