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