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