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