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