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