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