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