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