This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
buildtoc: make a warning clearer
[perl5.git] / pod / buildtoc
CommitLineData
41630250
JH
1#!/usr/bin/perl -w
2
3use strict;
d5e2eea9 4use vars qw($masterpodfile %Build %Targets $Verbose $Quiet %Ignore
b0b6bf2b 5 @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
d89d11bb 6 %Copies %Generated $Test);
41630250
JH
7use File::Spec;
8use File::Find;
9use FindBin;
10use Text::Tabs;
11use Text::Wrap;
12use Getopt::Long;
6d664f07 13use Carp;
41630250
JH
14
15no locale;
bac61051 16require 5.010;
41630250 17
d5e2eea9
NC
18{
19 my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
20
21 sub abs_from_top {
22 my $path = shift;
23 return File::Spec->catdir($Top, split /\//, $path) if $path =~ s!/\z!!;
24 return File::Spec->catfile($Top, split /\//, $path);
25 }
26}
27
28$masterpodfile = abs_from_top('pod.lst');
41630250
JH
29
30# Generate any/all of these files
31# --verbose gives slightly more output
d092c3cd 32# --quiet suppresses routine warnings
41630250
JH
33# --build-all tries to build everything
34# --build-foo updates foo as follows
35# --showfiles shows the files to be changed
5733ee18
NC
36# --test exit if perl.pod, pod.lst, MANIFEST are consistent, and regenerated
37# files are up to date, die otherwise.
41630250
JH
38
39%Targets
40 = (
d5e2eea9
NC
41 toc => 'pod/perltoc.pod',
42 manifest => 'MANIFEST',
43 perlpod => 'pod/perl.pod',
44 vms => 'vms/descrip_mms.template',
45 nmake => 'win32/Makefile',
46 dmake => 'win32/makefile.mk',
47 podmak => 'win32/pod.mak',
48 # plan9 => 'plan9/mkfile'),
49 unix => 'Makefile.SH',
8537f021 50 # TODO: add roffitall
41630250
JH
51 );
52
d5e2eea9
NC
53foreach (values %Targets) {
54 $_ = abs_from_top($_);
55}
56
d0f3b1ad
DM
57# process command-line switches
58
41630250
JH
59{
60 my @files = keys %Targets;
61 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
62 my $showfiles;
9dce16cd 63 my %build_these;
41630250
JH
64 die <<__USAGE__
65$0: Usage: $0 [--verbose] [--showfiles] $filesopts
66__USAGE__
67 unless @ARGV
68 && GetOptions (verbose => \$Verbose,
d092c3cd 69 quiet => \$Quiet,
41630250 70 showfiles => \$showfiles,
d89d11bb 71 test => \$Test,
9dce16cd
NC
72 map {+"build-$_", \$build_these{$_}} @files, 'all');
73 if ($build_these{all}) {
74 %Build = %Targets;
75 } else {
76 while (my ($file, $want) = each %build_these) {
77 $Build{$file} = $Targets{$file} if $want;
78 }
79 }
41630250
JH
80 if ($showfiles) {
81 print
82 join(" ",
83 sort { lc $a cmp lc $b }
84 map {
85 my ($v, $d, $f) = File::Spec->splitpath($_);
86 my @d;
87 @d = defined $d ? File::Spec->splitdir($d) : ();
88 shift @d if @d;
89 File::Spec->catfile(@d ?
90 (@d == 1 && $d[0] eq '' ? () : @d)
91 : "pod", $f);
9dce16cd 92 } @Targets{@files}),
41630250
JH
93 "\n";
94 exit(0);
95 }
96}
97
98# Don't copy these top level READMEs
99%Ignore
100 = (
41630250
JH
101 micro => 1,
102# vms => 1,
103 );
104
105if ($Verbose) {
d0f3b1ad 106 print "I will be building $_\n" foreach keys %Build;
41630250
JH
107}
108
d0f3b1ad
DM
109
110# process pod.lst
111
bac61051 112open my $master, '<', $masterpodfile or die "$0: Can't open $masterpodfile: $!";
41630250 113
b0b6bf2b
AT
114my ($delta_source, $delta_target);
115
bac61051 116foreach (<$master>) {
41630250
JH
117 next if /^\#/;
118
119 # At least one upper case letter somewhere in the first group
8927c9d8 120 if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
41630250
JH
121 # it's a heading
122 my $flags = $1;
8927c9d8 123 $flags =~ tr/h//d;
41630250 124 my %flags = (header => 1);
8927c9d8
NC
125 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
126 $flags{aux} = 1 if $flags =~ tr/a//d;
41630250
JH
127 die "$0: Unknown flag found in heading line: $_" if length $flags;
128 push @Master, [\%flags, $2];
129
130 } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
131 # it's a section
132 my ($flags, $filename, $desc) = ($1, $2, $3);
133
134 my %flags = (indent => 0);
135 $flags{indent} = $1 if $flags =~ s/(\d+)//;
b0b6bf2b 136 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
41630250 137 $flags{aux} = 1 if $flags =~ tr/a//d;
b0b6bf2b
AT
138
139 if ($flags =~ tr/D//d) {
37ee6528 140 $flags{manifest_omit} = 1;
b0b6bf2b
AT
141 $delta_source = "$filename.pod";
142 }
143 if ($flags =~ tr/d//d) {
37ee6528 144 $flags{perlpod_omit} = 1;
b0b6bf2b
AT
145 $delta_target = "$filename.pod";
146 }
344af494 147 $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
b0b6bf2b 148
41630250
JH
149 if ($flags =~ tr/r//d) {
150 my $readme = $filename;
151 $readme =~ s/^perl//;
152 $Readmepods{$filename} = $Readmes{$readme} = $desc;
153 $flags{readme} = 1;
154 } elsif ($flags{aux}) {
155 $Aux{$filename} = $desc;
156 } else {
157 $Pods{$filename} = $desc;
158 }
159 die "$0: Unknown flag found in section line: $_" if length $flags;
160 push @Master, [\%flags, $filename, $desc];
161 } elsif (/^$/) {
162 push @Master, undef;
163 } else {
164 die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
165 }
166}
b0b6bf2b
AT
167if (defined $delta_source) {
168 if (defined $delta_target) {
169 # This way round so that keys can act as a MANIFEST skip list
170 # Targets will aways be in the pod directory. Currently we can only cope
dd0cfdaa 171 # with sources being in the same directory.
b0b6bf2b
AT
172 $Copies{$delta_target} = $delta_source;
173 } else {
174 die "$0: delta source defined but not target";
175 }
176} elsif (defined $delta_target) {
600dcb9e 177 die "$0: delta target defined but not source";
b0b6bf2b 178}
41630250 179
bac61051 180close $master;
41630250
JH
181
182# Sanity cross check
183{
184 my (%disk_pods, @disk_pods);
185 my (@manipods, %manipods);
186 my (@manireadmes, %manireadmes);
187 my (@perlpods, %perlpods);
188 my (%our_pods);
189
190 # Convert these to a list of filenames.
191 foreach (keys %Pods, keys %Readmepods) {
192 $our_pods{"$_.pod"}++;
193 }
194
d5e2eea9 195 opendir my $dh, abs_from_top('pod/');
d0f3b1ad 196 while (defined ($_ = readdir $dh)) {
d5e2eea9
NC
197 next unless /\.pod\z/;
198 push @disk_pods, $_;
199 ++$disk_pods{$_};
200 }
41630250 201
b0b6bf2b
AT
202 # Things we copy from won't be in perl.pod
203 # Things we copy to won't be in MANIFEST
b0b6bf2b 204
d5e2eea9
NC
205 my $filename = abs_from_top('MANIFEST');
206 open my $mani, '<', $filename or die "$0: opening $filename failed: $!";
207 while (<$mani>) {
41630250
JH
208 if (m!^pod/([^.]+\.pod)\s+!i) {
209 push @manipods, $1;
210 } elsif (m!^README\.(\S+)\s+!i) {
211 next if $Ignore{$1};
212 push @manireadmes, "perl$1.pod";
213 }
214 }
d5e2eea9 215 close $mani or die $!;
41630250
JH
216 @manipods{@manipods} = @manipods;
217 @manireadmes{@manireadmes} = @manireadmes;
218
d5e2eea9
NC
219 $filename = abs_from_top('pod/perl.pod');
220 open my $perlpod, '<', $filename or die "$0: opening $filename failed: $!\n";
221 while (<$perlpod>) {
41630250
JH
222 if (/^For ease of access, /../^\(If you're intending /) {
223 if (/^\s+(perl\S*)\s+\w/) {
224 push @perlpods, "$1.pod";
225 }
226 }
227 }
d5e2eea9 228 close $perlpod or die $!;
41630250
JH
229 die "$0: could not find the pod listing of perl.pod\n"
230 unless @perlpods;
231 @perlpods{@perlpods} = @perlpods;
232
d89d11bb 233 my @inconsistent;
41630250 234 foreach my $i (sort keys %disk_pods) {
d89d11bb 235 push @inconsistent, "$0: $i exists but is unknown by buildtoc\n"
41630250 236 unless $our_pods{$i};
d89d11bb 237 push @inconsistent, "$0: $i exists but is unknown by ../MANIFEST\n"
344af494 238 if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
d89d11bb 239 push @inconsistent, "$0: $i exists but is unknown by perl.pod\n"
81e1aac7 240 if !$perlpods{$i} && !exists $Copies{$i};
41630250 241 }
78fb583c 242 my %BuildFiles;
b5f0cad0
RB
243 foreach my $path (values %Build) {
244 (undef, undef, my $file) = File::Spec->splitpath($path);
245 ++$BuildFiles{$file}
246 }
81e1aac7 247
41630250 248 foreach my $i (sort keys %our_pods) {
d89d11bb 249 push @inconsistent, "$0: $i is known by buildtoc but does not exist\n"
78fb583c 250 unless $disk_pods{$i} or $BuildFiles{$i};
41630250
JH
251 }
252 foreach my $i (sort keys %manipods) {
d89d11bb 253 push @inconsistent, "$0: $i is known by ../MANIFEST but does not exist\n"
41630250 254 unless $disk_pods{$i};
d89d11bb 255 push @inconsistent, "$0: $i is known by ../MANIFEST but is marked as generated\n"
344af494 256 if $Generated{$i};
41630250
JH
257 }
258 foreach my $i (sort keys %perlpods) {
d89d11bb 259 push @inconsistent, "$0: $i is known by perl.pod but does not exist\n"
78fb583c 260 unless $disk_pods{$i} or $BuildFiles{$i};
41630250 261 }
d89d11bb 262 if ($Test) {
5733ee18
NC
263 delete $Build{toc};
264 printf "1..%d\n", 1 + scalar keys %Build;
d89d11bb
TC
265 if (@inconsistent) {
266 print "not ok 1\n";
267 die @inconsistent
268 }
269 print "ok 1\n";
d89d11bb
TC
270 }
271 else {
272 warn @inconsistent if @inconsistent;
273 }
41630250
JH
274}
275
0b01631d 276# Find all the modules
15e75242 277if ($Build{toc}) {
41630250 278 my @modpods;
9a8cc8a4 279 find \&getpods => abs_from_top('lib/');
41630250
JH
280
281 sub getpods {
282 if (/\.p(od|m)$/) {
283 my $file = $File::Find::name;
d5e2eea9 284 return if $file =~ qr!/lib/Pod/Functions.pm\z!; # Used only by pod itself
41630250
JH
285 return if $file =~ m!(?:^|/)t/!;
286 return if $file =~ m!lib/Attribute/Handlers/demo/!;
287 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
288 return if $file =~ m!lib/Math/BigInt/t/!;
289 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
290 return if $file =~ m!XS/(?:APItest|Typemap)!;
be6d6286
HS
291 my $pod = $file;
292 return if $pod =~ s/pm$/pod/ && -e $pod;
bac61051 293 unless (open my $f, '<', $_) {
41630250
JH
294 warn "$0: bogus <$file>: $!";
295 system "ls", "-l", $file;
296 }
297 else {
298 my $line;
bac61051 299 while ($line = <$f>) {
41630250
JH
300 if ($line =~ /^=head1\s+NAME\b/) {
301 push @modpods, $file;
41630250
JH
302 return;
303 }
304 }
3533364a 305 warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet;
41630250
JH
306 }
307 }
308 }
309
310 die "$0: no pods" unless @modpods;
311
312 my %done;
313 for (@modpods) {
11eb54fe
NC
314 my $name = $_;
315 $name =~ s/\.p(m|od)$//;
316 $name =~ s-.*?/lib/--;
317 $name =~ s-/-::-g;
3eb77e4b
NC
318 next if $done{$name}++;
319
41630250
JH
320 if ($name =~ /^[a-z]/) {
321 $Pragmata{$name} = $_;
322 } else {
41630250
JH
323 $Modules{$name} = $_;
324 }
325 }
326}
327
8537f021 328# OK. Now a lot of ancillary function definitions follow
41630250
JH
329# Main program returns at "Do stuff"
330
d871876a
NC
331my $OUT;
332
02cc404a 333sub do_toc {
d5e2eea9 334 my $filename = shift;
41630250 335
c0f8aaaa 336 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250 337
97f32038
JH
338 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
339 # This file is autogenerated by buildtoc from all the other pods.
340 # Edit those files and run buildtoc --build-toc to effect changes.
97f32038 341
41630250
JH
342 =head1 NAME
343
344 perltoc - perl documentation table of contents
345
346 =head1 DESCRIPTION
347
348 This page provides a brief table of contents for the rest of the Perl
349 documentation set. It is meant to be scanned quickly or grepped
350 through to locate the proper section you're looking for.
351
352 =head1 BASIC DOCUMENTATION
353
354EOPOD2B
355#' make emacs happy
356
357 # All the things in the master list that happen to be pod filenames
84f07fb2 358 foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master) {
d5e2eea9 359 podset($_->[1], abs_from_top("pod/$_->[1].pod"));
84f07fb2 360 }
41630250
JH
361
362
c0f8aaaa 363 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250
JH
364
365
366
367 =head1 PRAGMA DOCUMENTATION
368
369EOPOD2B
370
84f07fb2
NC
371 foreach (sort keys %Pragmata) {
372 podset($_, $Pragmata{$_});
373 }
41630250 374
c0f8aaaa 375 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250
JH
376
377
378
379 =head1 MODULE DOCUMENTATION
380
381EOPOD2B
382
84f07fb2
NC
383 foreach (sort keys %Modules) {
384 podset($_, $Modules{$_});
385 }
41630250
JH
386
387 $_= <<"EOPOD2B";
388
389
390 =head1 AUXILIARY DOCUMENTATION
391
392 Here should be listed all the extra programs' documentation, but they
393 don't all have manual pages yet:
394
395 =over 4
396
397EOPOD2B
398
399 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
400 $_ .= <<"EOPOD2B" ;
401
402 =back
403
404 =head1 AUTHOR
405
406 Larry Wall <F<larry\@wall.org>>, with the help of oodles
407 of other folks.
408
409
410EOPOD2B
411
412 s/^\t//gm;
c0f8aaaa 413 $OUT .= "$_\n";
d871876a 414
39440e4b 415 $OUT =~ s/\n\s+\n/\n\n/gs;
f20404e1 416 $OUT =~ s/\n{3,}/\n\n/g;
b8ce93b8
NC
417
418 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
419
02cc404a 420 return $OUT;
41630250
JH
421}
422
423# Below are all the auxiliary routines for generating perltoc.pod
424
425my ($inhead1, $inhead2, $initem);
426
427sub podset {
84f07fb2 428 my ($pod, $file) = @_;
41630250 429
536d7404
NC
430 local $/ = '';
431
84f07fb2 432 open my $fh, '<', $file or die "Can't open file '$file' for $pod: $!";
0b01631d 433
84f07fb2 434 while(<$fh>) {
16114dde 435 tr/\015//d;
41630250 436 if (s/^=head1 (NAME)\s*/=head2 /) {
41630250 437 unhead1();
c0f8aaaa 438 $OUT .= "\n\n=head2 ";
84f07fb2 439 $_ = <$fh>;
767650bc
NC
440 # Remove svn keyword expansions from the Perl FAQ
441 s/ \(\$Revision: \d+ \$\)//g;
32ebae07 442 if ( /^\s*\Q$pod\E\b/ ) {
41630250 443 s/$pod\.pm/$pod/; # '.pm' in NAME !?
41630250
JH
444 } else {
445 s/^/$pod, /;
41630250 446 }
41630250 447 }
1fa7865d 448 elsif (s/^=head1 (.*)/=item $1/) {
41630250 449 unhead2();
c0f8aaaa 450 $OUT .= "=over 4\n\n" unless $inhead1;
41630250 451 $inhead1 = 1;
1fa7865d 452 $_ .= "\n";
41630250 453 }
1fa7865d 454 elsif (s/^=head2 (.*)/=item $1/) {
41630250 455 unitem();
c0f8aaaa 456 $OUT .= "=over 4\n\n" unless $inhead2;
41630250 457 $inhead2 = 1;
1fa7865d 458 $_ .= "\n";
41630250 459 }
1fa7865d 460 elsif (s/^=item ([^=].*)/$1/) {
41630250
JH
461 next if $pod eq 'perldiag';
462 s/^\s*\*\s*$// && next;
463 s/^\s*\*\s*//;
464 s/\n/ /g;
465 s/\s+$//;
466 next if /^[\d.]+$/;
467 next if $pod eq 'perlmodlib' && /^ftp:/;
c0f8aaaa 468 $OUT .= ", " if $initem;
41630250
JH
469 $initem = 1;
470 s/\.$//;
471 s/^-X\b/-I<X>/;
41630250 472 }
1fa7865d
NC
473 else {
474 unhead1() if /^=cut\s*\n/;
41630250
JH
475 next;
476 }
1fa7865d 477 $OUT .= $_;
41630250
JH
478 }
479}
480
481sub unhead1 {
482 unhead2();
483 if ($inhead1) {
c0f8aaaa 484 $OUT .= "\n\n=back\n\n";
41630250
JH
485 }
486 $inhead1 = 0;
487}
488
489sub unhead2 {
490 unitem();
491 if ($inhead2) {
c0f8aaaa 492 $OUT .= "\n\n=back\n\n";
41630250
JH
493 }
494 $inhead2 = 0;
495}
496
497sub unitem {
498 if ($initem) {
c0f8aaaa 499 $OUT .= "\n\n";
41630250
JH
500 }
501 $initem = 0;
502}
503
41630250
JH
504# End of original buildtoc. From here on are routines to generate new sections
505# for and inplace edit other files
506
507sub generate_perlpod {
508 my @output;
509 my $maxlength = 0;
510 foreach (@Master) {
511 my $flags = $_->[0];
512 next if $flags->{aux};
b0b6bf2b 513 next if $flags->{perlpod_omit};
41630250
JH
514
515 if (@$_ == 2) {
516 # Heading
517 push @output, "=head2 $_->[1]\n";
518 } elsif (@$_ == 3) {
519 # Section
520 my $start = " " x (4 + $flags->{indent}) . $_->[1];
521 $maxlength = length $start if length ($start) > $maxlength;
522 push @output, [$start, $_->[2]];
523 } elsif (@$_ == 0) {
524 # blank line
525 push @output, "\n";
526 } else {
527 die "$0: Illegal length " . scalar @$_;
528 }
529 }
530 # want at least 2 spaces padding
531 $maxlength += 2;
532 $maxlength = ($maxlength + 3) & ~3;
533 # sprintf gives $1.....$2 where ... are spaces:
534 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
535 @output);
536}
537
538
539sub generate_manifest {
c69ca1d4 540 # Annoyingly, unexpand doesn't consider it good form to replace a single
41630250
JH
541 # space before a tab with a tab
542 # Annoyingly (2) it returns read only values.
453d7764 543 my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_);
41630250
JH
544 map {s/ \t/\t\t/g; $_} @temp;
545}
546sub generate_manifest_pod {
b0b6bf2b 547 generate_manifest map {["pod/$_.pod", $Pods{$_}]}
3dc608da 548 sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
41630250
JH
549}
550sub generate_manifest_readme {
dd0cfdaa
NC
551 generate_manifest sort {$a->[0] cmp $b->[0]}
552 ["README.vms", "Notes about installing the VMS port"],
553 map {["README.$_", $Readmes{$_}]} keys %Readmes;
41630250
JH
554}
555
556sub generate_roffitall {
557 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
558 "\t\t\\",
559 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
560 "\t\t\\",
561 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
562 "\t\t\\",
563 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
564 )
565}
566
567sub generate_descrip_mms_1 {
568 local $Text::Wrap::columns = 150;
569 my $count = 0;
570 my @lines = map {"pod" . $count++ . " = $_"}
bae7ea06 571 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
41630250
JH
572 sort keys %Pods, keys %Readmepods);
573 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
574}
575
576sub generate_descrip_mms_2 {
dd0cfdaa
NC
577 map {<<"SNIP"}
578[.lib.pods]$_.pod : [.pod]$_.pod
579 \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
580 Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
41630250
JH
581SNIP
582 sort keys %Pods, keys %Readmepods;
583}
584
585sub generate_nmake_1 {
b0b6bf2b
AT
586 # XXX Fix this with File::Spec
587 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
588 sort keys %Readmes),
589 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
41630250
JH
590}
591
592# This doesn't have a trailing newline
593sub generate_nmake_2 {
594 # Spot the special case
595 local $Text::Wrap::columns = 76;
596 my $line = wrap ("\t ", "\t ",
9e64a656 597 join " ", sort keys %Copies, keys %Generated,
dd0cfdaa 598 map {"perl$_.pod"} keys %Readmes);
41630250 599 $line =~ s/$/ \\/mg;
b14c7f9a 600 $line =~ s/ \\$//;
41630250
JH
601 $line;
602}
603
604sub generate_pod_mak {
605 my $variable = shift;
606 my @lines;
607 my $line = join "\\\n", "\U$variable = ",
608 map {"\t$_.$variable\t"} sort keys %Pods;
609 # Special case
610 $line =~ s/.*perltoc.html.*\n//m;
611 $line;
612}
613
6d664f07
NC
614sub verify_contiguous {
615 my ($name, $content, $what) = @_;
616 my $sections = () = $content =~ m/\0+/g;
617 croak("$0: $name contains no $what") if $sections < 1;
618 croak("$0: $name contains discontiguous $what") if $sections > 1;
619}
620
41630250 621sub do_manifest {
131a60d2 622 my ($name, $prev) = @_;
41630250 623 my @manifest =
453d7764 624 grep {! m!^pod/[^.]+\.pod.*!}
131a60d2 625 grep {! m!^README\.(\S+)! || $Ignore{$1}} split "\n", $prev;
453d7764
NC
626 join "\n", (
627 # Dictionary order - fold and handle non-word chars as nothing
628 map { $_->[0] }
629 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
630 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
631 @manifest,
632 &generate_manifest_pod(),
633 &generate_manifest_readme()), '';
41630250
JH
634}
635
636sub do_nmake {
131a60d2 637 my ($name, $makefile) = @_;
41630250 638 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
6d664f07 639 verify_contiguous($name, $makefile, 'README copies');
b0b6bf2b
AT
640 # Now remove the other copies that follow
641 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
642 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
41630250 643
b14c7f9a
SH
644 $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
645 {"$1\n" . &generate_nmake_2."\n\t$2"}se;
41630250
JH
646 $makefile;
647}
648
649# shut up used only once warning
650*do_dmake = *do_dmake = \&do_nmake;
651
652sub do_perlpod {
131a60d2 653 my ($name, $pod) = @_;
41630250
JH
654
655 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
656 (?:\s+[a-z]{4,}.*\n # fooo
657 |=head.*\n # =head foo
658 |\s*\n # blank line
659 )+
660 }
661 {$1 . join "", &generate_perlpod}mxe) {
8537f021 662 die "$0: Failed to insert amendments in do_perlpod";
41630250
JH
663 }
664 $pod;
665}
666
667sub do_podmak {
131a60d2 668 my ($name, $body) = @_;
d525b9bc 669 foreach my $variable (qw(pod man html tex)) {
41630250
JH
670 die "$0: could not find $variable in $name"
671 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
672 {"\n" . generate_pod_mak ($variable)}se;
673 }
674 $body;
675}
676
677sub do_vms {
131a60d2 678 my ($name, $makefile) = @_;
41630250 679 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
6d664f07 680 verify_contiguous($name, $makefile, 'pod assignments');
41630250
JH
681 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
682
683 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
684
600dcb9e
CB
685# Looking for the macro defining the current perldelta:
686#PERLDELTA_CURRENT = [.pod]perl5139delta.pod
687
688 $makefile =~ s/\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n
689 /\0/sx;
690 verify_contiguous($name, $makefile, 'current perldelta macro');
691 $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$delta_target", ''/se;
692
41630250 693# Looking for rules like this
bae7ea06
NC
694# [.lib.pods]perl.pod : [.pod]perl.pod
695# @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
696# Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
41630250 697
bae7ea06 698 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
41630250 699 [^\n]+\n # Another line
bae7ea06 700 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
41630250 701 /\0/gsx;
6d664f07 702 verify_contiguous($name, $makefile, 'copy rules');
41630250 703 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
db34a22a 704
41630250
JH
705 $makefile;
706}
707
0dfdcd8a 708sub do_unix {
131a60d2 709 my ($name, $makefile_SH) = @_;
0dfdcd8a 710
7eb47696
NC
711 $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
712 {join ' ', $1, map "pod/$_",
713 sort keys %Copies, grep {!/perltoc/} keys %Generated
714 }mge;
8e7bc40f 715
37ee6528
FR
716# pod/perl511delta.pod: pod/perldelta.pod
717# cd pod && $(LNS) perldelta.pod perl511delta.pod
8e7bc40f
NC
718
719 $makefile_SH =~ s!(
720pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
e0be038f 721 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
8e7bc40f 722)+!\0!gm;
0dfdcd8a 723
6d664f07 724 verify_contiguous($name, $makefile_SH, 'copy rules');
0dfdcd8a 725
8e7bc40f
NC
726 my @copy_rules = map "
727pod/$_: pod/$Copies{$_}
e0be038f 728 \$(LNS) $Copies{$_} pod/$_
8e7bc40f 729", keys %Copies;
0dfdcd8a 730
8e7bc40f 731 $makefile_SH =~ s/\0+/join '', @copy_rules/se;
0dfdcd8a
NC
732 $makefile_SH;
733
734}
735
41630250
JH
736# Do stuff
737
738my $built;
739while (my ($target, $name) = each %Targets) {
e94c1c05 740 print "Working on target $target\n" if $Verbose;
41630250
JH
741 next unless $Build{$target};
742 $built++;
02cc404a 743 my ($orig, $mode);
41630250 744 print "Now processing $name\n" if $Verbose;
02cc404a
NC
745 if ($target ne "toc") {
746 local $/;
bac61051
NC
747 open my $thing, '<', $name or die "Can't open $name: $!";
748 binmode $thing;
749 $orig = <$thing>;
02cc404a
NC
750 die "$0: $name contains NUL bytes" if $orig =~ /\0/;
751 }
752
131a60d2 753 my $new = do {
41630250 754 no strict 'refs';
131a60d2 755 &{"do_$target"}($target, $orig);
41630250 756 };
02cc404a
NC
757
758 if (defined $orig) {
759 if ($new eq $orig) {
5733ee18
NC
760 if ($Test) {
761 printf "ok %d # $name is up to date\n", $built + 1;
762 } elsif ($Verbose) {
763 print "Was not modified\n";
764 }
765 next;
766 } elsif ($Test) {
767 printf "not ok %d # $name is up to date\n", $built + 1;
02cc404a
NC
768 next;
769 }
770 $mode = (stat $name)[2] // die "$0: Can't stat $name: $!";
771 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
41630250 772 }
02cc404a 773
bac61051
NC
774 open my $thing, '>', $name or die "$0: Can't open $name for writing: $!";
775 binmode $thing;
776 print $thing $new or die "$0: print to $name failed: $!";
777 close $thing or die "$0: close $name failed: $!";
02cc404a
NC
778 if (defined $mode) {
779 chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!";
780 }
41630250
JH
781}
782
5733ee18 783warn "$0: was not instructed to build anything\n" unless $built || $Test;