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