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");
198 for (@ARCHPODS) { s/$/.pod/ }
199 @ARCHPODS{@ARCHPODS} = ();
201 for (@pods) { s/$/.pod/ }
205 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
207 if (m!^pod/([^.]+\.pod)\s+!i) {
212 @MANIPODS{@MANIPODS} = ();
214 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
216 if (/^For ease of access, /../^\(If you're intending /) {
217 if (/^\s+(perl\S*)\s+\w/) {
218 push @PERLPODS, "$1.pod";
223 die "$0: could not find the pod listing of perl.pod\n"
225 @PERLPODS{@PERLPODS} = ();
227 # Cross-check against ourselves
228 # Cross-check against the MANIFEST
229 # Cross-check against the perl.pod
231 foreach my $i (sort keys %PODS) {
232 warn "$0: $i exists but is unknown by buildtoc\n"
233 unless exists $pods{$i};
234 warn "$0: $i exists but is unknown by ../MANIFEST\n"
235 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
236 warn "$0: $i exists but is unknown by perl.pod\n"
237 unless exists $PERLPODS{$i};
239 foreach my $i (sort keys %pods) {
240 warn "$0: $i is known by buildtoc but does not exist\n"
241 unless exists $PODS{$i};
243 foreach my $i (sort keys %MANIPODS) {
244 warn "$0: $i is known by ../MANIFEST but does not exist\n"
245 unless exists $PODS{$i};
247 foreach my $i (sort keys %PERLPODS) {
248 warn "$0: $i is known by perl.pod but does not exist\n"
249 unless exists $PODS{$i};
252 # We are ready to rock.
253 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
258 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
262 perltoc - perl documentation table of contents
266 This page provides a brief table of contents for the rest of the Perl
267 documentation set. It is meant to be scanned quickly or grepped
268 through to locate the proper section you're looking for.
270 =head1 BASIC DOCUMENTATION
277 find \&getpods => qw(../lib ../ext);
281 # Skip .pm files that have corresponding .pod files, and Functions.pm.
282 return if /(.*)\.pm$/ && -f "$1.pod";
283 my $file = $File::Find::name;
284 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
285 return if $file =~ m!lib/Attribute/Handlers/demo/!;
287 die "tut $name" if $file =~ /TUT/;
288 unless (open (F, "< $_\0")) {
289 warn "bogus <$file>: $!";
290 system "ls", "-l", $file;
294 while ($line = <F>) {
295 if ($line =~ /^=head1\s+NAME\b/) {
296 push @modpods, $file;
297 #warn "GOOD $file\n";
301 warn "$0: $file: cannot find =head1 NAME\n";
306 die "no pods" unless @modpods;
309 #($name) = /(\w+)\.p(m|od)$/;
310 $name = path2modname($_);
311 if ($name =~ /^[a-z]/) {
314 if ($done{$name}++) {
315 # warn "already did $_\n";
319 push @modname, $name;
323 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
327 =head1 PRAGMA DOCUMENTATION
331 podset(sort @pragmata);
333 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
337 =head1 MODULE DOCUMENTATION
341 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
343 ($_= <<EOPOD2B) =~ s/^\t//gm;
346 =head1 AUXILIARY DOCUMENTATION
348 Here should be listed all the extra programs' documentation, but they
349 don't all have manual pages yet:
375 Larry Wall <F<larry\@wall.org>>, with the help of oodles
381 output "\n"; # flush $LINE
388 if (s/^=head1 (NAME)\s*/=head2 /) {
389 $pod = path2modname($ARGV);
391 output "\n \n\n=head2 ";
393 if ( /^\s*$pod\b/ ) {
394 s/$pod\.pm/$pod/; # '.pm' in NAME !?
402 if (s/^=head1 (.*)/=item $1/) {
404 output "=over 4\n\n" unless $inhead1;
406 output $_; nl(); next;
408 if (s/^=head2 (.*)/=item $1/) {
410 output "=over 4\n\n" unless $inhead2;
412 output $_; nl(); next;
414 if (s/^=item ([^=].*)/$1/) {
415 next if $pod eq 'perldiag';
416 s/^\s*\*\s*$// && next;
421 next if $pod eq 'perlmodlib' && /^ftp:/;
422 ##print "=over 4\n\n" unless $initem;
423 output ", " if $initem;
429 if (s/^=cut\s*\n//) {
448 output "\n\n=back\n\n";
456 output "\n\n=back\n\n";
464 ##print "\n\n=back\n\n";
473 my $NEWLINE; # how many newlines have we seen recently
474 my $LINE; # what remains to be printed
477 for (split /(\n)/, shift) {
480 print OUT wrap('', '', $LINE);
488 elsif (/\S/ && length) {
497 close OUT or die "Can't close $file: $!";
498 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
499 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';