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