This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In buildtoc, call Text::Wrap::wrap() just before output.
[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) {
165 die "$0: delta target defined but not target";
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;
306 $name =~ s/(\w+)::\1/$1/;
3eb77e4b
NC
307 next if $done{$name}++;
308
41630250
JH
309 if ($name =~ /^[a-z]/) {
310 $Pragmata{$name} = $_;
311 } else {
41630250
JH
312 $Modules{$name} = $_;
313 }
314 }
315}
316
8537f021 317# OK. Now a lot of ancillary function definitions follow
41630250
JH
318# Main program returns at "Do stuff"
319
41630250
JH
320sub output ($);
321
d871876a
NC
322my $OUT;
323
41630250 324sub output_perltoc {
d5e2eea9 325 my $filename = shift;
41630250 326
671313d0 327 local $/ = '';
41630250
JH
328
329 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
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
356 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
357
358
359
360 =head1 PRAGMA DOCUMENTATION
361
362EOPOD2B
363
84f07fb2
NC
364 foreach (sort keys %Pragmata) {
365 podset($_, $Pragmata{$_});
366 }
41630250
JH
367
368 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
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;
406 output $_;
407 output "\n"; # flush $LINE
d871876a 408
39440e4b 409 $OUT =~ s/\n\s+\n/\n\n/gs;
f20404e1 410 $OUT =~ s/\n{3,}/\n\n/g;
b8ce93b8
NC
411
412 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
413
d871876a
NC
414 open OUT, '>', $filename or die "$0: creating $filename failed: $!";
415 print OUT $OUT;
0b01631d 416 close OUT;
41630250
JH
417}
418
419# Below are all the auxiliary routines for generating perltoc.pod
420
421my ($inhead1, $inhead2, $initem);
422
423sub podset {
84f07fb2 424 my ($pod, $file) = @_;
41630250 425
84f07fb2 426 open my $fh, '<', $file or die "Can't open file '$file' for $pod: $!";
0b01631d 427
84f07fb2 428 while(<$fh>) {
16114dde 429 tr/\015//d;
41630250 430 if (s/^=head1 (NAME)\s*/=head2 /) {
41630250 431 unhead1();
02a4b4d8 432 output "\n\n=head2 ";
84f07fb2 433 $_ = <$fh>;
767650bc
NC
434 # Remove svn keyword expansions from the Perl FAQ
435 s/ \(\$Revision: \d+ \$\)//g;
32ebae07 436 if ( /^\s*\Q$pod\E\b/ ) {
41630250
JH
437 s/$pod\.pm/$pod/; # '.pm' in NAME !?
438 output $_;
439 } else {
440 s/^/$pod, /;
441 output $_;
442 }
443 next;
444 }
445 if (s/^=head1 (.*)/=item $1/) {
446 unhead2();
447 output "=over 4\n\n" unless $inhead1;
448 $inhead1 = 1;
e777a914 449 output "$_\n"; next;
41630250
JH
450 }
451 if (s/^=head2 (.*)/=item $1/) {
452 unitem();
453 output "=over 4\n\n" unless $inhead2;
454 $inhead2 = 1;
e777a914 455 output "$_\n"; next;
41630250
JH
456 }
457 if (s/^=item ([^=].*)/$1/) {
458 next if $pod eq 'perldiag';
459 s/^\s*\*\s*$// && next;
460 s/^\s*\*\s*//;
461 s/\n/ /g;
462 s/\s+$//;
463 next if /^[\d.]+$/;
464 next if $pod eq 'perlmodlib' && /^ftp:/;
41630250
JH
465 output ", " if $initem;
466 $initem = 1;
467 s/\.$//;
468 s/^-X\b/-I<X>/;
469 output $_; next;
470 }
471 if (s/^=cut\s*\n//) {
472 unhead1();
473 next;
474 }
475 }
476}
477
478sub unhead1 {
479 unhead2();
480 if ($inhead1) {
481 output "\n\n=back\n\n";
482 }
483 $inhead1 = 0;
484}
485
486sub unhead2 {
487 unitem();
488 if ($inhead2) {
489 output "\n\n=back\n\n";
490 }
491 $inhead2 = 0;
492}
493
494sub unitem {
495 if ($initem) {
496 output "\n\n";
41630250
JH
497 }
498 $initem = 0;
499}
500
41630250 501sub output ($) {
b8ce93b8 502 $OUT .= shift;
41630250
JH
503}
504
505# End of original buildtoc. From here on are routines to generate new sections
506# for and inplace edit other files
507
508sub generate_perlpod {
509 my @output;
510 my $maxlength = 0;
511 foreach (@Master) {
512 my $flags = $_->[0];
513 next if $flags->{aux};
b0b6bf2b 514 next if $flags->{perlpod_omit};
41630250
JH
515
516 if (@$_ == 2) {
517 # Heading
518 push @output, "=head2 $_->[1]\n";
519 } elsif (@$_ == 3) {
520 # Section
521 my $start = " " x (4 + $flags->{indent}) . $_->[1];
522 $maxlength = length $start if length ($start) > $maxlength;
523 push @output, [$start, $_->[2]];
524 } elsif (@$_ == 0) {
525 # blank line
526 push @output, "\n";
527 } else {
528 die "$0: Illegal length " . scalar @$_;
529 }
530 }
531 # want at least 2 spaces padding
532 $maxlength += 2;
533 $maxlength = ($maxlength + 3) & ~3;
534 # sprintf gives $1.....$2 where ... are spaces:
535 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
536 @output);
537}
538
539
540sub generate_manifest {
c69ca1d4 541 # Annoyingly, unexpand doesn't consider it good form to replace a single
41630250
JH
542 # space before a tab with a tab
543 # Annoyingly (2) it returns read only values.
544 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
545 map {s/ \t/\t\t/g; $_} @temp;
546}
547sub generate_manifest_pod {
b0b6bf2b 548 generate_manifest map {["pod/$_.pod", $Pods{$_}]}
3dc608da 549 sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
41630250
JH
550}
551sub generate_manifest_readme {
dd0cfdaa
NC
552 generate_manifest sort {$a->[0] cmp $b->[0]}
553 ["README.vms", "Notes about installing the VMS port"],
554 map {["README.$_", $Readmes{$_}]} keys %Readmes;
41630250
JH
555}
556
557sub generate_roffitall {
558 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
559 "\t\t\\",
560 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
561 "\t\t\\",
562 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
563 "\t\t\\",
564 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
565 )
566}
567
568sub generate_descrip_mms_1 {
569 local $Text::Wrap::columns = 150;
570 my $count = 0;
571 my @lines = map {"pod" . $count++ . " = $_"}
bae7ea06 572 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
41630250
JH
573 sort keys %Pods, keys %Readmepods);
574 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
575}
576
577sub generate_descrip_mms_2 {
dd0cfdaa
NC
578 map {<<"SNIP"}
579[.lib.pods]$_.pod : [.pod]$_.pod
580 \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
581 Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
41630250
JH
582SNIP
583 sort keys %Pods, keys %Readmepods;
584}
585
db34a22a
NC
586sub generate_descrip_mms_3 {
587 map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
588 sort keys %Generated, keys %Copies;
589}
590
41630250 591sub generate_nmake_1 {
b0b6bf2b
AT
592 # XXX Fix this with File::Spec
593 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
594 sort keys %Readmes),
595 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
41630250
JH
596}
597
598# This doesn't have a trailing newline
599sub generate_nmake_2 {
600 # Spot the special case
601 local $Text::Wrap::columns = 76;
602 my $line = wrap ("\t ", "\t ",
9e64a656 603 join " ", sort keys %Copies, keys %Generated,
dd0cfdaa 604 map {"perl$_.pod"} keys %Readmes);
41630250 605 $line =~ s/$/ \\/mg;
b14c7f9a 606 $line =~ s/ \\$//;
41630250
JH
607 $line;
608}
609
610sub generate_pod_mak {
611 my $variable = shift;
612 my @lines;
613 my $line = join "\\\n", "\U$variable = ",
614 map {"\t$_.$variable\t"} sort keys %Pods;
615 # Special case
616 $line =~ s/.*perltoc.html.*\n//m;
617 $line;
618}
619
6d664f07
NC
620sub verify_contiguous {
621 my ($name, $content, $what) = @_;
622 my $sections = () = $content =~ m/\0+/g;
623 croak("$0: $name contains no $what") if $sections < 1;
624 croak("$0: $name contains discontiguous $what") if $sections > 1;
625}
626
41630250
JH
627sub do_manifest {
628 my $name = shift;
629 my @manifest =
630 grep {! m!^pod/[^.]+\.pod.*\n!}
631 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
632 # Dictionary order - fold and handle non-word chars as nothing
633 map { $_->[0] }
634 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
6578b326 635 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
41630250
JH
636 @manifest,
637 &generate_manifest_pod(),
638 &generate_manifest_readme();
639}
640
641sub do_nmake {
642 my $name = shift;
643 my $makefile = join '', @_;
644 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
645 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
6d664f07 646 verify_contiguous($name, $makefile, 'README copies');
b0b6bf2b
AT
647 # Now remove the other copies that follow
648 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
649 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
41630250 650
b14c7f9a
SH
651 $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
652 {"$1\n" . &generate_nmake_2."\n\t$2"}se;
41630250
JH
653 $makefile;
654}
655
656# shut up used only once warning
657*do_dmake = *do_dmake = \&do_nmake;
658
659sub do_perlpod {
660 my $name = shift;
661 my $pod = join '', @_;
662
663 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
664 (?:\s+[a-z]{4,}.*\n # fooo
665 |=head.*\n # =head foo
666 |\s*\n # blank line
667 )+
668 }
669 {$1 . join "", &generate_perlpod}mxe) {
8537f021 670 die "$0: Failed to insert amendments in do_perlpod";
41630250
JH
671 }
672 $pod;
673}
674
675sub do_podmak {
676 my $name = shift;
677 my $body = join '', @_;
d525b9bc 678 foreach my $variable (qw(pod man html tex)) {
41630250
JH
679 die "$0: could not find $variable in $name"
680 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
681 {"\n" . generate_pod_mak ($variable)}se;
682 }
683 $body;
684}
685
686sub do_vms {
687 my $name = shift;
688 my $makefile = join '', @_;
689 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
690 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
6d664f07 691 verify_contiguous($name, $makefile, 'pod assignments');
41630250
JH
692 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
693
694 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
695
696# Looking for rules like this
bae7ea06
NC
697# [.lib.pods]perl.pod : [.pod]perl.pod
698# @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
699# Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
41630250 700
bae7ea06 701 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
41630250 702 [^\n]+\n # Another line
bae7ea06 703 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
41630250 704 /\0/gsx;
6d664f07 705 verify_contiguous($name, $makefile, 'copy rules');
41630250 706 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
db34a22a
NC
707
708# Looking for rules like this:
709# - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
5369a12a 710 $makefile =~ s!(?:\t- If F\$Search\("\[\.pod\]perl\d*[a-z]+\Q.pod").nes."" Then Delete/NoConfirm/Log [.pod]perl\E\d*[a-z]+\.pod;\*\n)+!\0!sg;
6d664f07 711 verify_contiguous($name, $makefile, 'delete rules');
db34a22a
NC
712 $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
713
41630250
JH
714 $makefile;
715}
716
0dfdcd8a
NC
717sub do_unix {
718 my $name = shift;
719 my $makefile_SH = join '', @_;
720 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
721
7eb47696
NC
722 $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
723 {join ' ', $1, map "pod/$_",
724 sort keys %Copies, grep {!/perltoc/} keys %Generated
725 }mge;
8e7bc40f 726
37ee6528
FR
727# pod/perl511delta.pod: pod/perldelta.pod
728# cd pod && $(LNS) perldelta.pod perl511delta.pod
8e7bc40f
NC
729
730 $makefile_SH =~ s!(
731pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
e0be038f 732 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
8e7bc40f 733)+!\0!gm;
0dfdcd8a 734
6d664f07 735 verify_contiguous($name, $makefile_SH, 'copy rules');
0dfdcd8a 736
8e7bc40f
NC
737 my @copy_rules = map "
738pod/$_: pod/$Copies{$_}
e0be038f 739 \$(LNS) $Copies{$_} pod/$_
8e7bc40f 740", keys %Copies;
0dfdcd8a 741
8e7bc40f 742 $makefile_SH =~ s/\0+/join '', @copy_rules/se;
0dfdcd8a
NC
743 $makefile_SH;
744
745}
746
41630250
JH
747# Do stuff
748
749my $built;
750while (my ($target, $name) = each %Targets) {
e94c1c05 751 print "Working on target $target\n" if $Verbose;
41630250
JH
752 next unless $Build{$target};
753 $built++;
754 if ($target eq "toc") {
671313d0 755 print "Now processing $name\n" if $Verbose;
d5e2eea9 756 output_perltoc($name);
671313d0 757 print "Finished\n" if $Verbose;
41630250
JH
758 next;
759 }
760 print "Now processing $name\n" if $Verbose;
761 open THING, $name or die "Can't open $name: $!";
2187fa19 762 binmode THING;
41630250
JH
763 my @orig = <THING>;
764 my $orig = join '', @orig;
765 close THING;
766 my @new = do {
767 no strict 'refs';
768 &{"do_$target"}($target, @orig);
769 };
770 my $new = join '', @new;
771 if ($new eq $orig) {
772 print "Was not modified\n" if $Verbose;
773 next;
774 }
9b6e0960 775 my $mode = (stat $name)[2] // die "$0: Can't stat $name: $!";
41630250
JH
776 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
777 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
2187fa19 778 binmode THING;
41630250 779 print THING $new or die "$0: print to $name failed: $!";
e1020413 780 close THING or die "$0: close $name failed: $!";
9b6e0960 781 chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!";
41630250
JH
782}
783
784warn "$0: was not instructed to build anything\n" unless $built;