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