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");
177 for (@ARCHPODS) { s/$/.pod/ }
178 @ARCHPODS{@ARCHPODS} = ();
180 for (@pods) { s/$/.pod/ }
184 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
186 if (m!^pod/([^.]+\.pod)\s+!i) {
191 @MANIPODS{@MANIPODS} = ();
193 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
195 if (/^For ease of access, /../^\(If you're intending /) {
196 if (/^\s+(perl\S*)\s+\w/) {
197 push @PERLPODS, "$1.pod";
202 die "$0: could not find the pod listing of perl.pod\n"
204 @PERLPODS{@PERLPODS} = ();
206 # Cross-check against ourselves
207 # Cross-check against the MANIFEST
208 # Cross-check against the perl.pod
210 foreach my $i (sort keys %PODS) {
211 warn "$0: $i exists but is unknown by buildtoc\n"
212 unless exists $pods{$i};
213 warn "$0: $i exists but is unknown by ../MANIFEST\n"
214 if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
215 warn "$0: $i exists but is unknown by perl.pod\n"
216 unless exists $PERLPODS{$i};
218 foreach my $i (sort keys %pods) {
219 warn "$0: $i is known by buildtoc but does not exist\n"
220 unless exists $PODS{$i};
222 foreach my $i (sort keys %MANIPODS) {
223 warn "$0: $i is known by ../MANIFEST but does not exist\n"
224 unless exists $PODS{$i};
226 foreach my $i (sort keys %PERLPODS) {
227 warn "$0: $i is known by perl.pod but does not exist\n"
228 unless exists $PODS{$i};
231 # We are ready to rock.
232 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
237 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
241 perltoc - perl documentation table of contents
245 This page provides a brief table of contents for the rest of the Perl
246 documentation set. It is meant to be scanned quickly or grepped
247 through to locate the proper section you're looking for.
249 =head1 BASIC DOCUMENTATION
256 find \&getpods => qw(../lib ../ext);
260 # Skip .pm files that have corresponding .pod files, and Functions.pm.
261 return if /(.*)\.pm$/ && -f "$1.pod";
262 my $file = $File::Find::name;
263 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
265 die "tut $name" if $file =~ /TUT/;
266 unless (open (F, "< $_\0")) {
267 warn "bogus <$file>: $!";
268 system "ls", "-l", $file;
272 while ($line = <F>) {
273 if ($line =~ /^=head1\s+NAME\b/) {
274 push @modpods, $file;
275 #warn "GOOD $file\n";
279 warn "$0: $file: cannot find =head1 NAME\n";
284 die "no pods" unless @modpods;
287 #($name) = /(\w+)\.p(m|od)$/;
288 $name = path2modname($_);
289 if ($name =~ /^[a-z]/) {
292 if ($done{$name}++) {
293 # warn "already did $_\n";
297 push @modname, $name;
301 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
305 =head1 PRAGMA DOCUMENTATION
309 podset(sort @pragmata);
311 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
315 =head1 MODULE DOCUMENTATION
319 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
321 ($_= <<EOPOD2B) =~ s/^\t//gm;
324 =head1 AUXILIARY DOCUMENTATION
326 Here should be listed all the extra programs' documentation, but they
327 don't all have manual pages yet:
353 Larry Wall <F<larry\@wall.org>>, with the help of oodles
359 output "\n"; # flush $LINE
366 if (s/^=head1 (NAME)\s*/=head2 /) {
367 $pod = path2modname($ARGV);
369 output "\n \n\n=head2 ";
371 if ( /^\s*$pod\b/ ) {
372 s/$pod\.pm/$pod/; # '.pm' in NAME !?
380 if (s/^=head1 (.*)/=item $1/) {
382 output "=over\n\n" unless $inhead1;
384 output $_; nl(); next;
386 if (s/^=head2 (.*)/=item $1/) {
388 output "=over\n\n" unless $inhead2;
390 output $_; nl(); next;
392 if (s/^=item ([^=].*)/$1/) {
393 next if $pod eq 'perldiag';
394 s/^\s*\*\s*$// && next;
399 next if $pod eq 'perlmodlib' && /^ftp:/;
400 ##print "=over\n\n" unless $initem;
401 output ", " if $initem;
407 if (s/^=cut\s*\n//) {
426 output "\n\n=back\n\n";
434 output "\n\n=back\n\n";
442 ##print "\n\n=back\n\n";
451 my $NEWLINE; # how many newlines have we seen recently
452 my $LINE; # what remains to be printed
455 for (split /(\n)/, shift) {
458 print OUT wrap('', '', $LINE);
466 elsif (/\S/ && length) {
475 close OUT or die "Can't close $file: $!";
476 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
477 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';