This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In buildtoc, convert all the do_* functions to taking 2 scalars.
[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.
453d7764 533 my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_);
41630250
JH
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 611sub do_manifest {
131a60d2 612 my ($name, $prev) = @_;
41630250 613 my @manifest =
453d7764 614 grep {! m!^pod/[^.]+\.pod.*!}
131a60d2 615 grep {! m!^README\.(\S+)! || $Ignore{$1}} split "\n", $prev;
453d7764
NC
616 join "\n", (
617 # Dictionary order - fold and handle non-word chars as nothing
618 map { $_->[0] }
619 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
620 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
621 @manifest,
622 &generate_manifest_pod(),
623 &generate_manifest_readme()), '';
41630250
JH
624}
625
626sub do_nmake {
131a60d2 627 my ($name, $makefile) = @_;
41630250
JH
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 {
131a60d2 644 my ($name, $pod) = @_;
41630250
JH
645
646 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
647 (?:\s+[a-z]{4,}.*\n # fooo
648 |=head.*\n # =head foo
649 |\s*\n # blank line
650 )+
651 }
652 {$1 . join "", &generate_perlpod}mxe) {
8537f021 653 die "$0: Failed to insert amendments in do_perlpod";
41630250
JH
654 }
655 $pod;
656}
657
658sub do_podmak {
131a60d2 659 my ($name, $body) = @_;
d525b9bc 660 foreach my $variable (qw(pod man html tex)) {
41630250
JH
661 die "$0: could not find $variable in $name"
662 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
663 {"\n" . generate_pod_mak ($variable)}se;
664 }
665 $body;
666}
667
668sub do_vms {
131a60d2 669 my ($name, $makefile) = @_;
41630250
JH
670 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
671 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
6d664f07 672 verify_contiguous($name, $makefile, 'pod assignments');
41630250
JH
673 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
674
675 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
676
600dcb9e
CB
677# Looking for the macro defining the current perldelta:
678#PERLDELTA_CURRENT = [.pod]perl5139delta.pod
679
680 $makefile =~ s/\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n
681 /\0/sx;
682 verify_contiguous($name, $makefile, 'current perldelta macro');
683 $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$delta_target", ''/se;
684
41630250 685# Looking for rules like this
bae7ea06
NC
686# [.lib.pods]perl.pod : [.pod]perl.pod
687# @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
688# Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
41630250 689
bae7ea06 690 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
41630250 691 [^\n]+\n # Another line
bae7ea06 692 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
41630250 693 /\0/gsx;
6d664f07 694 verify_contiguous($name, $makefile, 'copy rules');
41630250 695 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
db34a22a 696
41630250
JH
697 $makefile;
698}
699
0dfdcd8a 700sub do_unix {
131a60d2 701 my ($name, $makefile_SH) = @_;
0dfdcd8a
NC
702 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
703
7eb47696
NC
704 $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
705 {join ' ', $1, map "pod/$_",
706 sort keys %Copies, grep {!/perltoc/} keys %Generated
707 }mge;
8e7bc40f 708
37ee6528
FR
709# pod/perl511delta.pod: pod/perldelta.pod
710# cd pod && $(LNS) perldelta.pod perl511delta.pod
8e7bc40f
NC
711
712 $makefile_SH =~ s!(
713pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
e0be038f 714 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
8e7bc40f 715)+!\0!gm;
0dfdcd8a 716
6d664f07 717 verify_contiguous($name, $makefile_SH, 'copy rules');
0dfdcd8a 718
8e7bc40f
NC
719 my @copy_rules = map "
720pod/$_: pod/$Copies{$_}
e0be038f 721 \$(LNS) $Copies{$_} pod/$_
8e7bc40f 722", keys %Copies;
0dfdcd8a 723
8e7bc40f 724 $makefile_SH =~ s/\0+/join '', @copy_rules/se;
0dfdcd8a
NC
725 $makefile_SH;
726
727}
728
41630250
JH
729# Do stuff
730
731my $built;
732while (my ($target, $name) = each %Targets) {
e94c1c05 733 print "Working on target $target\n" if $Verbose;
41630250
JH
734 next unless $Build{$target};
735 $built++;
736 if ($target eq "toc") {
671313d0 737 print "Now processing $name\n" if $Verbose;
d5e2eea9 738 output_perltoc($name);
671313d0 739 print "Finished\n" if $Verbose;
41630250
JH
740 next;
741 }
742 print "Now processing $name\n" if $Verbose;
131a60d2 743 local $/;
41630250 744 open THING, $name or die "Can't open $name: $!";
2187fa19 745 binmode THING;
131a60d2 746 my $orig = <THING>;
41630250 747 close THING;
131a60d2 748 my $new = do {
41630250 749 no strict 'refs';
131a60d2 750 &{"do_$target"}($target, $orig);
41630250 751 };
41630250
JH
752 if ($new eq $orig) {
753 print "Was not modified\n" if $Verbose;
754 next;
755 }
9b6e0960 756 my $mode = (stat $name)[2] // die "$0: Can't stat $name: $!";
41630250
JH
757 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
758 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
2187fa19 759 binmode THING;
41630250 760 print THING $new or die "$0: print to $name failed: $!";
e1020413 761 close THING or die "$0: close $name failed: $!";
9b6e0960 762 chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!";
41630250
JH
763}
764
765warn "$0: was not instructed to build anything\n" unless $built;