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